(in-package :cl-user) (defclass owl2-test () ((jena-model :accessor jena-model :initarg :jena-model))) (defun read-testcase (url) (if (not (#"matches" url "(http|file):.*")) (setq url (format nil "file://~a" (namestring (truename url))))) (let ((model (#"createDefaultModel" 'modelfactory))) (#"read" model (if (uri-p url) (uri-full url) url)) (make-instance 'owl2-test :jena-model model))) (defmethod functional-syntax-strings ((test owl2-test)) (loop for property in (list !owl2t:fsPremiseOntology !owl2t:fsConclusionOntology !owl2t:fsNonConclusionOntology) append (loop with iterator = (#"listObjectsOfProperty" (jena-model test) (#"getProperty" (jena-model test) (uri-full property))) while (#"hasNext" iterator) for item = (#"next" iterator) collect (#"getLexicalForm" item)))) (defun run-tests () (let ((files (mapcar 'namestring (directory "/Users/alanr/repos/lsw/trunk/owl/owl2/tests/*.owl")))) (loop for file in files do (mapcar 't-rdf (mapcar 'parse-functional-syntax (functional-syntax-strings (read-testcase file)))))) (let ((files (mapcar 'namestring (directory "/Users/alanr/repos/lsw/trunk/owl/owl2/tests/*.ofn")))) (loop for file in files do (with-open-file (f file) (mapcar 't-rdf (mapcar 'parse-functional-syntax (list (with-output-to-string (s) (loop for line = (read-line f nil :eof) until (eq line :eof) do (princ line s) (terpri s)))) )))))) (defun testwiki-to-owl-url (url) (let* ((localname (#"replaceFirst" url ".*/" "")) (firstpart (subseq url 0 (- (length url) (length localname))))) (format nil "~aSpecial:Ask/-5B-5B:~a-5D-5D/format%3Dowltest" firstpart (#"replaceAll" localname "-" "-2D")))) (defun test-newfeatures () (let ((page (get-url "http://www.w3.org/2007/OWL/wiki/Test_Wrangler_Notes" :persist nil :force-refetch t :dont-cache t))) (let ((links (loop for link in (mapcar 'car (all-matches page "(?s)(?i)a href=\"(.*?)\"" 1)) when (#"matches" link ".*New-Fe.*") collect link))) (loop for link in links for owllink = (testwiki-to-owl-url link) for case = (read-testcase owllink) do (format t "~%**** ~a~%~a~%" (#"replaceFirst" link ".*/" "") link) (loop for ont in (functional-syntax-strings case) do (format t "~a~%" ont) (multiple-value-bind (value errorp) (ignore-errors (princ (t-rdf (parse-functional-syntax ont))) (terpri)) (if errorp (if (typep errorp 'condition) (apply #'format t (simple-condition-format-control errorp) (simple-condition-format-arguments errorp)) (print (setq @ errorp)))))))))) (defun testowl-fs2rdf (url) (let ((case (read-testcase url))) (format t "~%**** ~a~%~a~%" (#"replaceFirst" url ".*/" "") url) (loop for ont in (functional-syntax-strings case) do (format t "~a~%" ont) (multiple-value-bind (value errorp) (ignore-errors (princ (t-rdf (parse-functional-syntax ont))) (terpri)) (if errorp (if (typep errorp 'condition) (apply #'format t (simple-condition-format-control errorp) (simple-condition-format-arguments errorp)) (print (setq @ errorp)))))))) (defparameter *owl2tests* (make-hash-table )) (defvar *force-owl2tests-reinit* nil) (defun translation-testcase (name ontology &optional (force-init *force-owl2tests-reinit*)) (setf (gethash name *owl2tests*) ontology) (testcase-gen name "owl2:tests;fs2rdf;" `(("source" ,ontology)) force-init)) (defun testcase-gen (name directory ontologies &optional (force-init *force-owl2tests-reinit*)) (let ((resultsfile (namestring (translate-logical-pathname (format nil "~a~a" directory (string-downcase (string name)))))) (parsed (loop for (role ontology) in ontologies collect (list role ontology (parse-functional-syntax ontology))))) (unless (and (probe-file resultsfile) (not force-init)) (format t "initializing test case results for ~a" name) (flet ((maybe-blank (el) (if (and (uri-p el) (uri-blank-p el)) (#"replaceFirst" (uri-full el) "urn:blank:" "_:b") (if (and (consp el) (eq (car el) :literal)) (if (eq (third el) !rdf:text) (if (find #\@ (second el)) (apply 'format nil "\"~a\"@~a" (car (all-matches (second el) "(.*)@([^@]*)" 1 2))) (format t "\"~a\"@" (second el))) (format nil "~s^^<~a>" (second el) (uri-full (third el)))) (format nil "<~a>" (uri-full el)))))) (with-open-file (f resultsfile :direction :output :if-does-not-exist :create :if-exists :supersede) (let ((*print-case* :downcase)) (loop for (role fs ont) in parsed do (format f ";; Ontology '~a' in functional syntax~%~%~a~%" role fs) (format f "~%;; Ontology '~a' parsed~%" role) (pprint (eval-uri-reader-macro ont) f) (terpri f) (format f "~%;; Ontology '~a' in rdf/xml~%~%" role) (format f "~a~%" (t-rdf ont)) (format f ";; Ontology '~a' as ntriples~%~%" role) (loop for triple in (reverse (t-collect ont)) do (format f "~a " (maybe-blank (first triple))) (format f "<~a> " (uri-full (second triple))) (format f "~a . ~%" (maybe-blank (third triple)))) (terpri f)))) )))) (defun entailment-testcase (name sense profiles comment ont1 ont2 &optional (force-init *force-owl2tests-reinit*)) (let ((dir (ensure-directories-exist (format nil "owl2:tests;~a-entailment;" (string-downcase (string sense)))))) (testcase-gen name dir (list (list "premise" ont1) (list (if (eq sense :positive) "conclusion" "nonconclusion") ont2))))) (defun profiles-testcase (name profiles comment ont &optional (force-init *force-owl2tests-reinit*)) (let ((dir (ensure-directories-exist (format nil "owl2:tests;profiles;")))) (testcase-gen name dir (list (list "premise" ont)) force-init))) ;; http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/Owl2-rl-invalid-mincard ;; Example profile in wiki format ;; ;; {{ConsistencyTestCase ;; |id=owl2-rl-valid-mincard ;; |description=OWL 2 RL does not allow min cardinality ;; |author=Zhe Wu ;; |syntax=RDF/XML ;; |dl=In DL ;; |ql=Don't know ;; |el=Don't know ;; |rl=Not in RL ;; |semantics=Test applies both to OWL DL and to OWL FULL semantics ;; |consistent-ontology= ;; ;; ;; ;; ;; 1 ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; }} (defun testcase-wiki-gen-profile ()) (defun today-string () "2009-05-20") (defun translation-testcase-wiki-gen (bot name comment consistent? &optional (dl? nil dl-supplied?) (ql? nil ql-supplied?) (el? nil el-supplied?) (rl? nil rl-supplied?)) (let* ((*print-case* :downcase) (pagename (format nil "FS2RDF-~a-ar" name)) (rdfpagename (format nil "~a-RDFXML" pagename)) (url (format nil "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/~a" pagename)) (rdfurl (format nil "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/~a" rdfpagename)) (fs-ont (gethash name *owl2tests*)) (maincontent (format nil "{{~a |description=~a |author=Alan Ruttenberg |syntax=Functional syntax |~aconsistent-ontology=~a |id=~a |semantics=Test applies both to OWL DL and to OWL FULL semantics |dl=~a |ql=~a |el=~a |rl=~a |specref=http://www.w3.org/TR/owl2-mapping-to-rdf/ |auxiliary syntax=~a |proposed=~a }}" (if consistent? "ConsistencyTestCase" "InconsistencyTestCase") comment (if consistent? "" "in") fs-ont pagename (if dl-supplied? (if dl? "In DL" "Not in DL") "") (if ql-supplied? (if ql? "In QL" "Not in QL") "") (if el-supplied? (if el? "In EL" "Not in EL") "") (if rl-supplied? (if rl? "In RL" "Not in RL") "") rdfpagename (today-string) )) (rdfxml-content (format nil "This page provides a manually translated normative [[Test case syntax::Test:RDFXML|RDF/XML syntax]] version for [[~a]]. == Premise ontology ({{Downloadlink|p}}) == {{Conversionlinks|p|rdfxml}} {{RDFValidatorLink|p}} {{#Property:premise ontology|~a}}" pagename (t-rdf (parse-functional-syntax fs-ont) '("" "http://example.org/"))))) (if (not *bot*) (format t "No bot, so skipping ~a~%" pagename) (progn (let ((before (raw-page-content bot pagename))) (when (not (equal before maincontent)) (format t "Updating ~a~%" url) (set-page-text bot pagename maincontent) (let ((before (raw-page-content bot rdfpagename))) (when (not (equal before rdfxml-content)) (format t "Updating ~a~%" rdfurl) (set-page-text bot rdfpagename rdfxml-content))))))) ; (format t "URL: ~a~% ~a ~%----URL: ~a~%~a~%....~%" ; url maincontent rdfurl rdfxml-content) )) #| (loop for link in '("http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-DisjointUnion-001" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-NegativeObjectPropertyAssertion-001" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-NegativeDataPropertyAssertion-001" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-SelfRestriction-001" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-SelfRestriction-002" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-ObjectQCR-001" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-ObjectQCR-002" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-DataQCR-001" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-ReflexiveProperty-001" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-IrreflexiveProperty-001" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-AsymmetricProperty-001" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-DisjointObjectProperties-001" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-DisjointDataProperties-001" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-ObjectPropertyChain-001" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-Keys-001" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-Keys-002" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-Keys-003" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-Keys-004" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-Keys-005" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-Keys-006" "http://km.aifb.uni-karlsruhe.de/projects/owltests/index.php/New-Feature-Keys-007") for owllink = (test-wiki-to-owl-url link) for case = (read-testcase owllink) do (format t "~a~%" (#"replaceFirst" link ".*/" "")) (multiple-value-bind (value errorp) (ignore-errors (map nil 't-print (mapcar 'parse-functional-syntax (functional-syntax-strings case)))) (if errorp (if (typep errorp 'condition) (apply #'format t (simple-condition-format-control errorp) (simple-condition-format-arguments errorp)) (print (setq @ errorp)))))) |#