Commit a2d09ec1 authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Extracted tests to separate files; made new test systems.

parent 40bbbb5e
......@@ -47,6 +47,7 @@
"COM.INFORMATIMAGO.CLEXT.CLOSER-WEAK")
#+clisp (:import-from "EXT" "GC")
#+cmu (:import-from "EXTENSIONS" "GC")
#+ccl (:import-from "CCL" "GC")
(:export "TEST/ALL"))
(in-package "COM.INFORMATIMAGO.CLEXT.CLOSER-WEAK.TEST")
......@@ -54,7 +55,6 @@
;;;
;;; This tests.lisp is taken from clisp-2.38/tests/tests.lisp
;;; and modified to take only the weak-*.tst files we're interested in.
......@@ -198,13 +198,17 @@ NIL: sacla-style: forms should evaluate to non-NIL.")
(setq out (and *eval-out* (get-output-stream-string *eval-out*))
err (and *eval-err* (get-output-stream-string *eval-err*)))
(cond ((eql result my-result)
(format t "~&EQL-OK: ~S~%" result))
(format t "~&EQL-OK: ~S~%" result)
(progress-success))
((equal result my-result)
(format t "~&EQUAL-OK: ~S~%" result))
(format t "~&EQUAL-OK: ~S~%" result)
(progress-success))
((equalp result my-result)
(format t "~&EQUALP-OK: ~S~%" result))
(format t "~&EQUALP-OK: ~S~%" result)
(progress-success))
(t
(incf error-count)
(progress-failure-message form "~&ERROR!! ~S should be ~S !~%" my-result result)
(format t "~&ERROR!! ~S should be ~S !~%" my-result result)
(format log "~&Form: ~S~%CORRECT: ~S~%~7A: ~S~%~@[~A~%~]"
form result lisp-implementation
......@@ -256,9 +260,11 @@ NIL: sacla-style: forms should evaluate to non-NIL.")
(multiple-value-bind (typep-result typep-error)
(ignore-errors (typep my-result errtype))
(cond ((and (not typep-error) typep-result)
(format t "~&OK: ~S~%" errtype))
(format t "~&OK: ~S~%" errtype)
(progress-success))
(t
(incf error-count)
(progress-failure-message form "~&ERROR!! ~S instead of ~S !~%" my-result errtype)
(format t "~&ERROR!! ~S instead of ~S !~%" my-result errtype)
(format log "~&Form: ~S~%CORRECT: ~S~%~7A: ~S~%~
~[~*~:;OUT:~%~S~%~]~[~*~:;ERR:~%~S~]~2%"
......@@ -266,6 +272,16 @@ NIL: sacla-style: forms should evaluate to non-NIL.")
(length out) out (length err) err)))))))
(values total-count error-count)))
(defvar *dirpath* nil)
(eval-when (:compile-toplevel)
(defparameter *dirpath* #.(make-pathname :name nil :type nil :version nil
:defaults *compile-file-pathname*)))
(eval-when (:load-toplevel :execute)
(defparameter *dirpath* (or *dirpath* (make-pathname :name nil :type nil :version nil
:defaults *load-pathname*))))
(defvar *run-test-tester* #'do-test)
(defvar *run-test-type* "tst")
(defvar *run-test-erg* "erg")
......@@ -278,23 +294,27 @@ NIL: sacla-style: forms should evaluate to non-NIL.")
(logname testname)
&aux (logfile (merge-extension *run-test-erg* logname))
error-count total-count *run-test-truename*)
(with-open-file (s (merge-extension *run-test-type* testname)
(let ((*default-pathname-defaults* *dirpath*))
(with-open-file (s (merge-pathnames
(merge-extension *run-test-type* testname)
*dirpath* nil)
:direction :input)
(setq *run-test-truename* (truename s))
(format t "~&~s: started ~s~%" 'run-test s)
(with-open-file (log logfile :direction :output
#+(or cmu sbcl) :if-exists
#+(or cmu sbcl) :supersede
#+ansi-cl :if-exists #+ansi-cl :new-version)
(setq logfile (truename log))
(let* ((*package* *package*) (*print-circle* t) (*print-pretty* nil)
(*eval-err* (make-string-output-stream))
(*error-output* (make-broadcast-stream *error-output* *eval-err*))
(*eval-out* (make-string-output-stream))
(*standard-output* (make-broadcast-stream *standard-output*
*eval-out*)))
(setf (values total-count error-count)
(funcall *run-test-tester* s log)))))
(setq *run-test-truename* (truename s))
(format t "~&~s: started ~s~%" 'run-test s)
(with-open-file (log (merge-pathnames logfile *dirpath* nil)
:direction :output
#+(or cmu sbcl) :if-exists
#+(or cmu sbcl) :supersede
#+ansi-cl :if-exists #+ansi-cl :new-version)
(setq logfile (truename log))
(let* ((*package* *package*) (*print-circle* t) (*print-pretty* nil)
(*eval-err* (make-string-output-stream))
(*error-output* (make-broadcast-stream *error-output* *eval-err*))
(*eval-out* (make-string-output-stream))
(*standard-output* (make-broadcast-stream *standard-output*
*eval-out*)))
(setf (values total-count error-count)
(funcall *run-test-tester* s log))))))
(format t "~&~s: finished ~s (~:d error~:p out of ~:d test~:p)~%"
'run-test testname error-count total-count)
(if (zerop error-count)
......@@ -325,11 +345,15 @@ NIL: sacla-style: forms should evaluate to non-NIL.")
(warn "no ~S files in directories ~S" *run-test-type* dirlist))))
(defun run-all-tests (&key (disable-risky t)
(verbose t)
((:eval-method *eval-method*) *eval-method*))
(let ((res ())
#+clisp (custom:*load-paths* nil)
(*features* (if disable-risky *features*
(cons :enable-risky-tests *features*))))
(cons :enable-risky-tests *features*)))
(*standard-output* (if verbose
*standard-output*
(make-broadcast-stream))))
;; Since weakptr can run on #+cmu, we should run
;; the other too with CLOSER-WEAK.
(dolist (ff '(#+(or clisp cmu sbcl) "weak-oid"
......@@ -347,8 +371,9 @@ NIL: sacla-style: forms should evaluate to non-NIL.")
(incf (third tmp) (third weak-res)))))
(report-results (nreverse res))))
(define-test test/all ()
(run-all-tests))
(run-all-tests :verbose nil))
#-(and) (progn
......
......@@ -38,6 +38,31 @@
;;;;
;;;;***************************************************************************
#-clisp
(asdf:defsystem "com.informatimago.clisp.test"
;; system attributes:
:description "Dummy tests the com.informatimago.clisp system."
:author "Pascal J. Bourguignon <pjb@informatimago.com>"
:maintainer "Pascal J. Bourguignon <pjb@informatimago.com>"
:licence "AGPL3"
;; component attributes:
:version "1.0.0"
:properties ((#:author-email . "pjb@informatimago.com")
(#:date . "Winter 2015")
((#:albert #:output-dir)
. "/tmp/documentation/com.informatimago.clisp.test/")
((#:albert #:formats) "docbook")
((#:albert #:docbook #:template) . "book")
((#:albert #:docbook #:bgcolor) . "white")
((#:albert #:docbook #:textcolor) . "black"))
#+asdf-unicode :encoding #+asdf-unicode :utf-8
:depends-on ()
:components ()
:perform (asdf:test-op
(operation system)
(declare (ignore operation system))))
#+clisp
(asdf:defsystem "com.informatimago.clisp.test"
;; system attributes:
:description "Tests the com.informatimago.clisp system."
......@@ -58,11 +83,11 @@
:depends-on ("com.informatimago.common-lisp.cesarum"
"com.informatimago.clisp")
:components ((:file "string-test" :depends-on ()))
:perform (asdf/lisp-action:test-op
:perform (asdf:test-op
(operation system)
(declare (ignore operation system))
(let ((*package* (find-package "COM.INFORMATIMAGO.CLISP.STRING.TEST")))
(uiop/package:symbol-call "COM.INFORMATIMAGO.CLISP.STRING.TEST"
"TEST/ALL"))))
(dolist (p '("COM.INFORMATIMAGO.CLISP.STRING.TEST"))
(let ((*package* (find-package p)))
(uiop/package:symbol-call p "TEST/ALL")))))
;;;; THE END ;;;;
......@@ -36,6 +36,8 @@
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SIMPLE-TEST"
"COM.INFORMATIMAGO.CLMISC.RESOURCE-UTILIZATION")
(:import-from "COM.INFORMATIMAGO.CLMISC.RESOURCE-UTILIZATION"
"READ-PARENTHESIZED-STRING")
(:export "TEST/ALL"))
(in-package "COM.INFORMATIMAGO.CLMISC.RESOURCE-UTILIZATION.TEST")
......@@ -45,13 +47,18 @@
:with success = 0
:for tcount :from 0
:for (input . output)
:in '(("" :eof) (" " :eof) ("(" :eof) (" ( " :eof)
(" (a(b)" :eof) (" (a(b)c" :eof) (" (a\\" :eof) (" (a\\b" :eof)
:in '(("" :eof)
(" " :eof)
("(" :eof)
(" ( " :eof)
(" (a(b)" :eof)
(" (a(b)c" :eof)
(" (a\\" :eof)
(" (a\\b" :eof)
(" (howdy doo ?)" "howdy doo ?")
("(howdy \\( doo ?)" "howdy ( doo ?")
("(howdy \\) doo ?)" "howdy ) doo ?")
("(a(b(c(d)e)f)g)h" "a(b(c(d)e)f)g")
)
("(a(b(c(d)e)f)g)h" "a(b(c(d)e)f)g"))
:for result = (with-input-from-string (stream input)
(multiple-value-list
(ignore-errors
......@@ -60,19 +67,21 @@
(progn
(incf success)
(progress-success))
(progress-failure input "~2%Reading parenthesized string ~S~
~% --> ~S~%expected ~S~%"
input result output))
:finally (format t "~&~30A ~4D cases, ~4D successful (~6,1F %)~%"
'read-parenthesized-string
tcount success (/ success tcount 0.01))))
(progress-failure-message input
"~2%Reading parenthesized string ~S~
~% --> ~S~%expected ~S~%"
input result output))
:finally (format t "~&~30A ~4D cases, ~4D successful (~6,1F %)~%"
'read-parenthesized-string
tcount success (/ success tcount 0.01))))
(define-test test/all ()
(test/read-parenthesized-string))
#||
(reporting-sru ()
......
......@@ -64,7 +64,7 @@
"com.informatimago.clisp" ; empty shell on non-clisp linux
)
:components ()
:in-order-to ((asdf:test-op (asdf:test-op "com.informatimago.tests"))))
:in-order-to ((asdf:test-op (asdf:test-op "com.informatimago.test"))))
;;;; THE END ;;;;
......@@ -35,7 +35,7 @@
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.A-STAR.TEST"
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SIMPLE-TEST"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.A-STAR.TEST")
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.A-STAR")
(:export "TEST/ALL"))
(in-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.A-STAR.TEST")
......
......@@ -36,6 +36,8 @@
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SIMPLE-TEST"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.CACHE")
(:import-from "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.CACHE"
"CACHE-MAP-ENTRIES")
(:export "TEST/ALL"))
(in-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.CACHE.TEST")
......@@ -43,55 +45,59 @@
(defvar *test-cache* nil)
(defvar *test-cache-2* nil)
(define-test test/cache ()
(ignore-errors (map nil (function delete-file) (directory "/tmp/cache/**/*.*")))
(setf *test-counter* 0)
(let ((delay 7))
(flet ((producer (key) (values (format nil "~A-~A" key
(incf *test-counter* ))
(+ delay (get-universal-time))))
(print-files ()
(dolist (file (sort (mapcar (function namestring) (directory "/tmp/cache/**/*.*"))
(function string<)))
(princ file) (terpri))))
(setf *test-cache* (make-cache #p"/tmp/cache/" (function producer)
:value-file-type "SYM"))
(assert-true (string= (cache-get *test-cache* :one) "ONE-1"))
(assert-true (string= (cache-get *test-cache* :two) "TWO-2"))
(assert-true (string= (cache-get *test-cache* :three) "THREE-3"))
(assert-true (string= (cache-get *test-cache* :one) "ONE-1"))
(assert-true (string= (cache-get *test-cache* :two) "TWO-2"))
(assert-true (string= (cache-get *test-cache* :three) "THREE-3"))
(setf *test-cache-2* (make-cache #p"/tmp/cache/" (function producer)))
(assert-true (string= (cache-get *test-cache-2* :one) "ONE-1"))
(assert-true (string= "SYM" (cache-value-file-type *test-cache-2*)))
(format t "~2&filled:~%")(finish-output)
(print-files)
(cache-expire *test-cache* :one)
(cache-expire *test-cache* :two :keep-file t)
(format t "~2&expired :one and :two:~%")(finish-output)
(print-files)
(assert-true (string= (cache-get *test-cache* :one) "ONE-4"))
(format t "~2&expirations~%~:{~15A in ~4D seconds~%~}"
(cache-map-entries *test-cache*
'list (lambda (entry)
(list
(entry-key entry)
(- (entry-expire-date entry)
(get-universal-time))))))
(format t "~2&waiting ~D s expiration of :one and :three:~%" delay)
(finish-output)
(sleep (1+ delay))
(assert-true (string= (cache-get *test-cache* :one) "ONE-5"))
(assert-true (string= (cache-get *test-cache* :three) "THREE-6"))
(cache-expire-all *test-cache*)
(format t "~2&expired all~%")(finish-output)
(print-files)
(assert-true (string= (cache-get *test-cache* :one) "ONE-7"))
(assert-true (string= (cache-get *test-cache* :three) "THREE-8"))
(assert-true (string= (cache-get *test-cache-2* :one) "ONE-7"))
(assert-true (string= (cache-get *test-cache-2* :three) "THREE-8"))
(cache-map-entries *test-cache* nil (function print)))))
(define-test test/cache (&key (verbose t))
(let ((*standard-output* (if verbose
*standard-output*
(make-broadcast-stream))))
(ignore-errors (map nil (function delete-file)
(directory "/tmp/cache/**/*.*")))
(setf *test-counter* 0)
(let ((delay 7))
(flet ((producer (key) (values (format nil "~A-~A" key
(incf *test-counter* ))
(+ delay (get-universal-time))))
(print-files ()
(dolist (file (sort (mapcar (function namestring) (directory "/tmp/cache/**/*.*"))
(function string<)))
(princ file) (terpri))))
(setf *test-cache* (make-cache #p"/tmp/cache/" (function producer)
:value-file-type "SYM"))
(assert-true (string= (cache-get *test-cache* :one) "ONE-1"))
(assert-true (string= (cache-get *test-cache* :two) "TWO-2"))
(assert-true (string= (cache-get *test-cache* :three) "THREE-3"))
(assert-true (string= (cache-get *test-cache* :one) "ONE-1"))
(assert-true (string= (cache-get *test-cache* :two) "TWO-2"))
(assert-true (string= (cache-get *test-cache* :three) "THREE-3"))
(setf *test-cache-2* (make-cache #p"/tmp/cache/" (function producer)))
(assert-true (string= (cache-get *test-cache-2* :one) "ONE-1"))
(assert-true (string= "SYM" (cache-value-file-type *test-cache-2*)))
(format t "~2&filled:~%")(finish-output)
(print-files)
(cache-expire *test-cache* :one)
(cache-expire *test-cache* :two :keep-file t)
(format t "~2&expired :one and :two:~%")(finish-output)
(print-files)
(assert-true (string= (cache-get *test-cache* :one) "ONE-4"))
(format t "~2&expirations~%~:{~15A in ~4D seconds~%~}"
(cache-map-entries *test-cache*
'list (lambda (entry)
(list
(entry-key entry)
(- (entry-expire-date entry)
(get-universal-time))))))
(format t "~2&waiting ~D s expiration of :one and :three:~%" delay)
(finish-output)
(sleep (1+ delay))
(assert-true (string= (cache-get *test-cache* :one) "ONE-5"))
(assert-true (string= (cache-get *test-cache* :three) "THREE-6"))
(cache-expire-all *test-cache*)
(format t "~2&expired all~%")(finish-output)
(print-files)
(assert-true (string= (cache-get *test-cache* :one) "ONE-7"))
(assert-true (string= (cache-get *test-cache* :three) "THREE-8"))
(assert-true (string= (cache-get *test-cache-2* :one) "ONE-7"))
(assert-true (string= (cache-get *test-cache-2* :three) "THREE-8"))
(cache-map-entries *test-cache* nil (function print))))))
......@@ -132,6 +138,6 @@
||#
(define-test test/all ()
(test/cache))
(test/cache :verbose nil))
;;;; THE END ;;;;
......@@ -38,7 +38,6 @@
;;;;**************************************************************************
(in-package "COMMON-LISP-USER")
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.CHARACTER-SETS"
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING")
......
......@@ -96,6 +96,8 @@ all written in 100% conforming Common Lisp.
(:file "llrbtree" :depends-on ())
(:file "queue" :depends-on ("utility"))
(:file "message-queue" :depends-on ("queue"))
(:file "priority-queue" :depends-on ())
;; Standards:
(:file "ascii" :depends-on ())
......
......@@ -39,8 +39,10 @@
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.INDEX-SET")
(:shadowing-import-from "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SET"
"UNION" "INTERSECTION" "MERGE" "INCLUDE")
(:import-from "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.INDEX-SET"
"EQUAL-RANGES" "COMPLEMENT-RANGES")
(:export "TEST/ALL"))
(in-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.INDEX-SET")
(in-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.INDEX-SET.TEST")
;;----------------------------------------------------------------------
......@@ -132,10 +134,14 @@
;;----------------------------------------------------------------------
;; INDEX-SET TESTS
(defun test/all ()
(define-test test/all ()
(let ((*package* (find-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.INDEX-SET")))
(test/range)
(test/range/complement)
(com.informatimago.common-lisp.cesarum.set.test:test/all/class 'index-set)))
;;;; THE END ;;;;
......@@ -35,7 +35,8 @@
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST.TEST"
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SIMPLE-TEST"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST"))
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST")
(:export "TEST/ALL"))
(in-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST.TEST")
......@@ -151,7 +152,7 @@
(assert-true (equal 'x (tree-find "x" '((a b (a b c d . x) |x|)) :test (function string=) :key (function string-downcase)))))
(define/test test/all ()
(define-test test/all ()
(test/list-lengths)
(test/list-elements)
(test/tree-find))
......
......@@ -15,6 +15,9 @@
;;;; progress-failure and macros callint it.
;;;; 2010-12-14 <PJB> Created.
;;;;BUGS
;;;;
;;;; - we should use source-form to parse lambda-list for define-test.
;;;;
;;;;LEGAL
;;;; AGPL3
;;;;
......@@ -326,7 +329,7 @@ EXAMPLE: (test equal (list 1 2 3) '(1 2 3))
"Like DEFUN, but wraps the body in test reporting boilerplate."
(let ((mandatory (loop
:for param :in parameters
:while (symbolp param)
:until (member param lambda-list-keywords)
:collect param)))
(multiple-value-bind (docstrings declarations forms) (parse-body :lambda body)
`(defun ,name ,parameters
......
......@@ -59,30 +59,30 @@
"com.informatimago.common-lisp")
:components ()
:in-order-to ((asdf:test-op
(asdftest-op "com.informatimago.common-lisp.lisp-sexp")
(asdftest-op "com.informatimago.common-lisp.lisp-reader")
(asdftest-op "com.informatimago.common-lisp.lisp-text")
(asdftest-op "com.informatimago.common-lisp.cesarum")
(asdftest-op "com.informatimago.common-lisp.picture")
(asdftest-op "com.informatimago.common-lisp.arithmetic")
(asdftest-op "com.informatimago.common-lisp.data-encoding")
(asdftest-op "com.informatimago.common-lisp.heap")
(asdftest-op "com.informatimago.common-lisp.html-base")
(asdftest-op "com.informatimago.common-lisp.html-generator")
(asdftest-op "com.informatimago.common-lisp.html-parser")
(asdftest-op "com.informatimago.common-lisp.http")
(asdftest-op "com.informatimago.common-lisp.bank")
(asdftest-op "com.informatimago.common-lisp.csv")
(asdftest-op "com.informatimago.common-lisp.diagram")
(asdftest-op "com.informatimago.common-lisp.regexp")
(asdftest-op "com.informatimago.common-lisp.ed")
(asdftest-op "com.informatimago.common-lisp.graphviz")
(asdftest-op "com.informatimago.common-lisp.invoice")
(asdftest-op "com.informatimago.common-lisp.interactive")
(asdftest-op "com.informatimago.common-lisp.parser")
(asdftest-op "com.informatimago.common-lisp.rfc2822")
(asdftest-op "com.informatimago.common-lisp.rfc3548")
;; not yet (asdftest-op "com.informatimago.common-lisp.telnet")
(asdftest-op "com.informatimago.common-lisp.unix"))))
(asdf:test-op "com.informatimago.common-lisp.lisp-sexp")
(asdf:test-op "com.informatimago.common-lisp.lisp-reader")
(asdf:test-op "com.informatimago.common-lisp.lisp-text")
(asdf:test-op "com.informatimago.common-lisp.cesarum")
(asdf:test-op "com.informatimago.common-lisp.picture")
(asdf:test-op "com.informatimago.common-lisp.arithmetic")
(asdf:test-op "com.informatimago.common-lisp.data-encoding")
(asdf:test-op "com.informatimago.common-lisp.heap")
(asdf:test-op "com.informatimago.common-lisp.html-base")
(asdf:test-op "com.informatimago.common-lisp.html-generator")
(asdf:test-op "com.informatimago.common-lisp.html-parser")
(asdf:test-op "com.informatimago.common-lisp.http")
(asdf:test-op "com.informatimago.common-lisp.bank")
(asdf:test-op "com.informatimago.common-lisp.csv")
(asdf:test-op "com.informatimago.common-lisp.diagram")
(asdf:test-op "com.informatimago.common-lisp.regexp")
(asdf:test-op "com.informatimago.common-lisp.ed")
(asdf:test-op "com.informatimago.common-lisp.graphviz")
(asdf:test-op "com.informatimago.common-lisp.invoice")
(asdf:test-op "com.informatimago.common-lisp.interactive")
(asdf:test-op "com.informatimago.common-lisp.parser")
(asdf:test-op "com.informatimago.common-lisp.rfc2822")
(asdf:test-op "com.informatimago.common-lisp.rfc3548")
;; not yet (asdf:test-op "com.informatimago.common-lisp.telnet")
(asdf:test-op "com.informatimago.common-lisp.unix"))))
;;;; THE END ;;;;
......@@ -35,6 +35,8 @@
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.DATA-ENCODING.BENCODE.TEST"
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SIMPLE-TEST"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY"
"COM.INFORMATIMAGO.COMMON-LISP.DATA-ENCODING.BENCODE")
(:export "TEST/ALL"))
(in-package "COM.INFORMATIMAGO.COMMON-LISP.DATA-ENCODING.BENCODE.TEST")
......
......@@ -39,7 +39,7 @@
"COM.INFORMATIMAGO.COMMON-LISP.DATA-ENCODING.DATA-ENCODING"))
(in-package "COM.INFORMATIMAGO.COMMON-LISP.DATA-ENCODING.DATA-ENCODING.TEST")
(progn
(eval-when (:compile-toplevel :load-toplevel :execute)
(def-enctype buint8 () (number unsigned 1 big-endian))
(def-enctype buint16 () (number unsigned 2 big-endian))
(def-enctype buint24 () (number unsigned 3 big-endian))
......@@ -62,7 +62,7 @@
(def-enctype cobol-string (len) (string len space :padded :strip))
(def-enctype pascal-string (len) (string len :green-length (number unsigned 1)))
(def-enctype c-string (len) (string len null :terminated))
);;progn
) ;;progn
(def-encrecord test-rec
......
......@@ -57,7 +57,7 @@
#+asdf-unicode :encoding #+asdf-unicode :utf-8
:depends-on ("com.informatimago.common-lisp.cesarum"
"com.informatimago.common-lisp.interactive")
:components ((:file "source-test" :depends-on nil))
:components ()
:perform (asdf/lisp-action:test-op
(operation system)
(declare (ignore operation system))
......
......@@ -57,7 +57,7 @@
#+asdf-unicode :encoding #+asdf-unicode :utf-8
:depends-on ("com.informatimago.common-lisp.cesarum"
"com.informatimago.common-lisp.lisp-text")
:components ((:file "source-test" :depends-on nil))
:components ()
:perform (asdf/lisp-action:test-op
(operation system)
(declare (ignore operation system))
......
......@@ -42,7 +42,6 @@
;;;;**************************************************************************
(in-package "COMMON-LISP-USER")
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.LISP-TEXT.SOURCE-TEXT"
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.READER")
......
......@@ -57,7 +57,7 @@
#+asdf-unicode :encoding #+asdf-unicode :utf-8
:depends-on ("com.informatimago.common-lisp.cesarum"
"com.informatimago.common-lisp.parser")
:components ((:file "source-test" :depends-on nil))
:components ()
:perform (asdf/lisp-action:test-op
(operation system)
(declare (ignore operation system))
......
......@@ -57,12 +57,12 @@
#+asdf-unicode :encoding #+asdf-unicode :utf-8
:depends-on ("com.informatimago.common-lisp.cesarum"
"com.informatimago.common-lisp.picture")
:components ((:file "source-test" :depends-on nil))
:components ((:file "picture-test" :depends-on nil))
:perform (asdf/lisp-action:test-op
(operation system)
(declare (ignore operation system))
(let ((*package* (find-package "COM.INFORMATIMAGO.COMMON-LISP.PICTURE.PICTURE.TEST")))
(uiop/package:symbol-call "COM.INFORMATIMAGO.COMMON-LISP.PICTURE.PICTURE.TEST"
"TEST/ALL"))))
(dolist (p '("COM.INFORMATIMAGO.COMMON-LISP.PICTURE.PICTURE.TEST"))
(let ((*package* (find-package p)))
(uiop/package:symbol-call p "TEST/ALL")))))
;;;; THE END ;;;;
......@@ -53,6 +53,6 @@
:com.informatimago.common-lisp.picture)
:components ((:file "regexp-emacs" :depends-on ())
(:file "regexp-posix" :depends-on ()))
:in-order-to ((asdf:test-op (asdf:test-op "com.informatimago.common-lisp.regexp"))))
:in-order-to ((asdf:test-op (asdf:test-op "com.informatimago.common-lisp.regexp.test"))))
;;;; THE END ;;;;
......@@ -35,6 +35,8 @@
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SIMPLE-TEST"
"COM.INFORMATIMAGO.COMMON-LISP.REGEXP.REGEXP-POSIX")
(:import-from "COM.INFORMATIMAGO.COMMON-LISP.REGEXP.REGEXP-POSIX"
"RANGE-SET-UNION" "RANGE")
(:export "TEST/ALL"))
(in-package "COM.INFORMATIMAGO.COMMON-LISP.REGEXP.REGEXP-POSIX.TEST")
......
......@@ -1215,11 +1215,24 @@ DO: complements the set.
;;
;; A range = an integer n for [n,n] or a cons (min . max) for [min,max].
(defstruct range min max)
(defstruct range %min %max)
;; (DEFMACRO MAKE-RANGE (MIN MAX) `(CONS ,MIN ,MAX))
;; (DEFMACRO RANGE-MIN (RANGE) `(IF (INTEGERP ,RANGE) ,RANGE (CAR ,RANGE)))
;; (DEFMACRO RANGE-MAX (RANGE) `(IF (INTEGERP ,RANGE) ,RANGE (CDR ,RANGE)))
(defgeneric range-min (range)
(:method ((range range)) (range-%min range))
(:method ((range cons)) (car range))
(:method ((range number)) range))
(defgeneric range-max (range)
(:method ((range range)) (range-%max range))
(:method ((range cons)) (cdr range))
(:method ((range number)) range))
(defgeneric (setf range-min) (new-value range)
(:method (new-value (range range)) (setf (range-%min range) new-value))
(:method (new-value (range cons)) (setf (car range) new-value)))
(defgeneric (setf range-max) (new-value range)
(:method (new-value (range range)) (setf (range-%max range) new-value))
(:method (new-value (range cons)) (setf (car range) new-value)))
(defun range-after-last (range)
(1+ (if (numberp range) range (range-max range))))
......
......@@ -102,14 +102,12 @@ publié en 1962 par MIT Press, un des maîtres­livres de l'Informatique.
(setf data (subseq data 0 (1- (length data)))))))
(define-test test ()
(define-test test/all-encodings ()
(dolist (enc '(:base16 :base32 :base64 :filebase64))
(dolist (line '(nil t))
(format t "~&TESTING ~A ~:[~;with lines~]" enc line)
(finish-output)
(test-encoding enc :line-width (when line 40) :ignore-crlf line)
(format t "~40TPASSED.~%")
(finish-output))))
(test/encoding enc :line-width (when line 40) :ignore-crlf line))))
(defun interactive-test/base16-encode ()
......@@ -124,6 +122,6 @@ publié en 1962 par MIT Press, un des maîtres­livres de l'Informatique.
(lambda (byte) (write-char (code-char byte)))))
(define-test test/all ()
(test))
(test/all-encodings))