From: Kevin M. Rosenberg Date: Thu, 8 May 2003 01:28:30 +0000 (+0000) Subject: r4874: Auto commit for Debian build X-Git-Tag: v2006ac.2~175 X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=commitdiff_plain;h=26b92c8df70bcd58358b343db835a599cdc56013 r4874: Auto commit for Debian build --- diff --git a/debian/changelog b/debian/changelog index 60990e9..ae47308 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-umlisp (3.1.0-1) unstable; urgency=low + + * Another pass of refactoring of parsing + + -- Kevin M. Rosenberg Wed, 7 May 2003 19:28:12 -0600 + cl-umlisp (3.0.1-1) unstable; urgency=low * Fix column name in find-ucoc diff --git a/parse-common.lisp b/parse-common.lisp index 38abc87..3141b73 100644 --- a/parse-common.lisp +++ b/parse-common.lisp @@ -7,7 +7,7 @@ ;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: parse-common.lisp,v 1.11 2003/05/07 22:54:16 kevin Exp $ +;;;; $Id: parse-common.lisp,v 1.12 2003/05/08 01:28:30 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -162,6 +162,8 @@ Currently, these are the LEX and NET files." (defun ensure-compiled-fun (fun) "Ensure that a function is compiled" (etypecase fun + (null + nil) (function (if (compiled-function-p fun) fun @@ -182,7 +184,7 @@ Currently, these are the LEX and NET files." ucol)) (defun make-empty-ucol (colname filename) - (warn "call in make-empty-ucol") + (warn "call in make-empty-ucol: ~A/~A" colname filename) (make-ucol (copy-seq colname) "Unknown" "" nil nil nil filename nil)) (defun find-ucol (colname filename) @@ -193,10 +195,10 @@ Currently, these are the LEX and NET files." "Returns umls-file structure for a filename" (find-if #'(lambda (f) (string-equal filename (fil f))) *umls-files*)) -(defun find-ucols-for-filename (filename) +(defun find-ucols-for-ufile (ufile) "Returns list of umls-cols for a file structure" - (loop for colname in (fields (find-ufile filename)) - collect (find-ucol colname filename))) + (loop for colname in (fields ufile) + collect (find-ucol colname (fil ufile)))) (defun umls-field-string-to-list (fmt) "Converts a comma delimited list of fields into a list of field names. Will @@ -216,7 +218,7 @@ append a unique number (starting at 2) onto a column name that is repeated in th (defun make-ufile (fil des table cls rws bts fields) (let ((ufile (make-instance 'ufile :fil fil :des des :table table :cls cls :rws rws :bts bts :fields fields))) - (setf (ucols ufile) (find-ucols-for-filename fil)) + (setf (ucols ufile) (find-ucols-for-ufile ufile)) ufile)) (defun datatype-for-colname (colname) diff --git a/run-tests.lisp b/run-tests.lisp index c9bbd31..3221a32 100644 --- a/run-tests.lisp +++ b/run-tests.lisp @@ -7,6 +7,7 @@ (require 'clsql) (require 'hyperobject) (load "umlisp.asd") +(load "umlisp-tests.asd") (asdf:oos 'asdf:test-op 'umlisp) (defun quit (&optional (code 0)) diff --git a/tests.lisp b/tests.lisp deleted file mode 100644 index 1a6487d..0000000 --- a/tests.lisp +++ /dev/null @@ -1,109 +0,0 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: tests.lisp -;;;; Purpose: Regression suite for UMLisp -;;;; Author: Kevin M. Rosenberg -;;;; Date Started: May 2003 -;;;; -;;;; $Id: tests.lisp,v 1.7 2003/05/07 22:53:36 kevin Exp $ -;;;; -;;;; This file, part of UMLisp, is -;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. -;;;; -;;;; UMLisp users are granted the rights to distribute and use this software -;;;; as governed by the terms of the GNU General Public License. -;;;; ************************************************************************* - -(defpackage #:umlisp-tests - (:use #:umlisp #:cl #:rtest #:kmrcl)) -(in-package #:umlisp-tests) - -(setf rtest::*catch-errors* nil) - -(rem-all-tests) - -(deftest qs.1 (umlisp::query-string mrcon (cui lui)) - "select CUI,LUI from MRCON") - -(deftest qs.1e (umlisp::query-string-eval 'mrcon '(cui lui)) - "select CUI,LUI from MRCON") - -(deftest qs.2 (umlisp::query-string mrcon (cui lui) 0) - "select CUI,LUI from MRCON and KCUILRL<=0") - -(deftest qs.2e (umlisp::query-string-eval 'mrcon '(cui lui) 0) - "select CUI,LUI from MRCON and KCUILRL<=0") - -(deftest qs.3 (umlisp::query-string mrcon (cui lui) nil cui 5) - "select CUI,LUI from MRCON where CUI=5") - -(deftest qs.3e (umlisp::query-string-eval 'mrcon '(cui lui) nil 'cui 5) - "select CUI,LUI from MRCON where CUI=5") - -(deftest qs.4 (umlisp::query-string mrcon (cui lui) nil kpfstr "Abc") - "select CUI,LUI from MRCON where KPFSTR='Abc'") - -(deftest qs.4e (umlisp::query-string-eval 'mrcon '(cui lui) nil 'kpfstr "Abc") - "select CUI,LUI from MRCON where KPFSTR='Abc'") - -(deftest qs.5 (umlisp::query-string mrcon (cui lui) 2 cui 5 :single t) - "select CUI,LUI from MRCON where CUI=5 and KCUILRL<=2 limit 1") - -(deftest qs.5e (umlisp::query-string-eval 'mrcon '(cui lui) 2 'cui 5 :single t) - "select CUI,LUI from MRCON where CUI=5 and KCUILRL<=2 limit 1") - -(deftest qs.6 (umlisp::query-string mrdef (sab def) 2 cui 39 :lrl ksrl :single t) - "select SAB,DEF from MRDEF where CUI=39 and KSRL<=2 limit 1") - -(deftest qs.6e (umlisp::query-string-eval 'mrdef '(sab def) 2 'cui 39 :lrl 'ksrl :single t) - "select SAB,DEF from MRDEF where CUI=39 and KSRL<=2 limit 1") - -(deftest qs.7 (umlisp::query-string mrdef (sab def) 2 cui 39 :lrl ksrl :order (cui asc)) - "select SAB,DEF from MRDEF where CUI=39 and KSRL<=2 order by CUI asc") - -(deftest qs.7e (umlisp::query-string-eval 'mrdef '(sab def) 2 'cui 39 :lrl 'ksrl :order '(cui asc)) - "select SAB,DEF from MRDEF where CUI=39 and KSRL<=2 order by CUI asc") - -(deftest qs.8 (umlisp::query-string mrdef (sab def) 2 cui 39 :lrl ksrl - :order (cui asc def desc)) - "select SAB,DEF from MRDEF where CUI=39 and KSRL<=2 order by CUI asc,DEF desc") - -(deftest qs.8e (umlisp::query-string-eval 'mrdef '(sab def) 2 'cui 39 :lrl 'ksrl - :order '(cui asc def desc)) - "select SAB,DEF from MRDEF where CUI=39 and KSRL<=2 order by CUI asc,DEF desc") - -(deftest ui.1 (umlisp::parse-cui "C0002341") 2341) -(deftest ui.2 (umlisp::parse-lui "L0002341") 2341) -(deftest ui.3 (umlisp::parse-sui "S0000000") 0) -(deftest ui.4 (umlisp::parse-tui "T123") 123) -(deftest ui.5 (fmt-cui 2341) "C0002341") -(deftest ui.6 (fmt-lui 2341) "L0002341") -(deftest ui.7 (fmt-sui 2341) "S0002341") -(deftest ui.8 (fmt-tui 231) "T231") -(deftest ui.9 (fmt-tui 231) "T231") -(deftest ui.10 (fmt-eui 231) "E0000231") -(deftest ui.11 (umlisp::make-cuisui 5 11) 50000011) -(deftest ui.12 (umlisp::decompose-cuisui 50000011) 5 11) -(deftest ui.13 (umlisp::parse-eui "E00002311") 2311) -(deftest ui.14 (umlisp::parse-lui "1234") 1234) -(deftest ui.15 (umlisp::parse-lui 1234) 1234) - -(defun f2 (&key (srl *current-srl*)) - "Return list of all ucon's" - (umlisp::with-umlisp-query ('mrcon (cui kpfstr kcuilrl) srl nil nil) - (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr - :lrl (ensure-integer kcuilrl)))) - -(defun f1 (&key (srl *current-srl*)) - "Return list of all ucon's" - (umlisp::with-sql-connection (db) - (clsql:map-query - 'list - #'(lambda (cui pfstr cuilrl) - (make-instance 'ucon :cui (ensure-integer cui) - :pfstr pfstr - :lrl (ensure-integer cuilrl))) - (umlisp::query-string 'mrcon '(cui kpfstr kcuilrl) srl nil nil) - :database db))) diff --git a/tests/parse.lisp b/tests/parse.lisp index e1dcd30..71a479b 100644 --- a/tests/parse.lisp +++ b/tests/parse.lisp @@ -7,7 +7,7 @@ ;;;; Author: Kevin M. Rosenberg ;;;; Date Started: May 2003 ;;;; -;;;; $Id: parse.lisp,v 1.1 2003/05/07 23:06:44 kevin Exp $ +;;;; $Id: parse.lisp,v 1.2 2003/05/08 01:28:30 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -17,3 +17,22 @@ ;;;; ************************************************************************* (in-package #:umlisp-tests) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (if (probe-file (umlisp::umls-pathname "MRFILES")) + (pushnew :umls-files cl:*features*) + (format t "~&Skipping tests based on UMLS distribution~%"))) + +(import '(umlisp::*umls-files* umlisp::*umls-cols*)) + +#+umls-files +(progn + (umlisp::ensure-init-umls) + (deftest uparse.1 (length *umls-files*) 52) + (deftest uparse.2 (length *umls-cols*) 327) + + ) ;; umls-files + +#+umls-files +(setq cl:*features* (delete :umls-files cl:*features*)) + diff --git a/umlisp-tests.asd b/umlisp-tests.asd new file mode 100644 index 0000000..df85109 --- /dev/null +++ b/umlisp-tests.asd @@ -0,0 +1,30 @@ +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: umlisp-tests.asd +;;;; Purpose: ASDF system definitionf for umlisp testing package +;;;; Author: Kevin M. Rosenberg +;;;; Date Started: Apr 2003 +;;;; +;;;; $Id: umlisp-tests.asd,v 1.1 2003/05/08 01:28:30 kevin Exp $ +;;;; ************************************************************************* + +(defpackage #:umlisp-tests-system + (:use #:asdf #:cl)) +(in-package #:umlisp-tests-system) + +(defsystem umlisp-tests + :depends-on (:rt :umlisp) + :components + ((:module tests + :components + ((:file "package") + (:file "basic" :depends-on ("package")) + (:file "parse" :depends-on ("package")))))) + +(defmethod perform ((o test-op) (c (eql (find-system :umlisp-tests)))) + (or (funcall (intern (symbol-name '#:do-tests) + (find-package '#:regression-test))) + (error "test-op failed"))) + diff --git a/umlisp.asd b/umlisp.asd index cccf49e..ff601c4 100644 --- a/umlisp.asd +++ b/umlisp.asd @@ -7,7 +7,7 @@ ;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: umlisp.asd,v 1.18 2003/05/07 22:53:36 kevin Exp $ +;;;; $Id: umlisp.asd,v 1.19 2003/05/08 01:28:30 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -40,13 +40,3 @@ (defmethod perform ((o test-op) (c (eql (find-system :umlisp)))) (oos 'load-op 'umlisp-tests) (oos 'test-op 'umlisp-tests)) - -#+(or allegro lispworks cmu sbcl openmcl scl) -(defsystem umlisp-tests - :depends-on (rt umlisp) - :components ((:file "tests"))) - -#+(or allegro lispworks cmu sbcl openmcl scl) -(defmethod perform ((o test-op) (c (eql (find-system :umlisp-tests)))) - (or (funcall (intern (symbol-name '#:do-tests) (find-package '#:rtest))) - (error "test-op failed")))