Commit 2d53d3a5 authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Merged.

parents 44cad215 8aaec2b8
......@@ -224,7 +224,7 @@ RETURN: A new list of name and aliases, with the ALIASES added, if
(list (mapcar (lambda (x) (mapcar (function string-upcase) (first x)))
sb-impl::*external-formats*)))
#-(or ccl clisp cmu sbcl)
#-(or ccl clisp cmu ecl sbcl)
(progn
(warn "What are the available external formats in ~A ?"
(lisp-implementation-type))
......
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: com.informatimago.common-lisp.cesarum-test.asd
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; ASD file to test the com.informatimago.common-lisp.cesarum library.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <[email protected]>
;;;;MODIFICATIONS
;;;; 2015-01-08 <PJB> Created this .asd file.
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2015 - 2015
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU Affero General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see http://www.gnu.org/licenses/
;;;;**************************************************************************
#+clisp
(unless custom:*ansi*
(warn "System ~A: clisp should be used with -ansi or (setf custom:*ansi* t) in ~/.clisprc"
:com.informatimago.common-lisp.cesarum-test))
(asdf:defsystem "com.informatimago.common-lisp.cesarum-test"
;; system attributes:
:description "Tests the cesarum library."
:author "Pascal J. Bourguignon <[email protected]>"
:maintainer "Pascal J. Bourguignon <[email protected]>"
:licence "AGPL3"
;; component attributes:
:name "com.informatimago.common-lisp.cesarum-test"
:version "1.3.3"
:properties ((#:author-email . "[email protected]")
(#:date . "Winter 2015")
((#:albert #:output-dir) . "/tmp/documentation/com.informatimago.common-lisp.cesarum-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 ("com.informatimago.common-lisp.cesarum")
:perform (test-op
(o s)
(uiop:symbol-call "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SET" "TEST/ALL")
(uiop:symbol-call "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.INDEX-SET" "TEST/ALL"))
:components ((:file "set-test" :depends-on ())
(:file "index-set-test" :depends-on ("set-test"))))
;;;; THE END ;;;;
......@@ -40,11 +40,11 @@
(asdf:defsystem :com.informatimago.common-lisp.cesarum
;; system attributes:
:description "Various general data types, algorithms, utilities and standards."
;; system attributes:
:description "Various general data types, algorithms, utilities and standards."
:long-description "
:long-description "
This system provides various kinds of packages:
......@@ -60,85 +60,86 @@ This system provides various kinds of packages:
all written in 100% conforming Common Lisp.
"
:author "Pascal J. Bourguignon <[email protected]>"
:maintainer "Pascal J. Bourguignon <[email protected]>"
:licence "AGPL3"
;; component attributes:
:name "com.informatimago.common-lisp.cesarum"
:version "1.3.3"
:properties ((#:author-email . "[email protected]")
(#:date . "Autumn 2010")
((#:albert #:output-dir) . "/tmp/documentation/com.informatimago.common-lisp.cesarum/")
((#:albert #:formats) . ("docbook"))
((#:albert #:docbook #:template) . "book")
((#:albert #:docbook #:bgcolor) . "white")
((#:albert #:docbook #:textcolor) . "black"))
:depends-on (:com.informatimago.common-lisp.lisp-sexp)
#+asdf-unicode :encoding #+asdf-unicode :utf-8
:components (
;; Simple Test Framework
(:file "simple-test" :depends-on ())
;; Common Lisp addendum:
(:file "array" :depends-on ())
(:file "sequence" :depends-on ())
(:file "list" :depends-on ())
(:file "utility" :depends-on ("list"))
(:file "string" :depends-on ("utility" "list" "ecma048"))
(:file "package" :depends-on ("utility"))
;; Data structures:
(:file "set" :depends-on ("simple-test" "utility" "array"))
(:file "index-set" :depends-on ("simple-test" "utility" "array" "sequence" "set"))
(:file "bset" :depends-on ("utility" "set"))
(:file "brelation" :depends-on ("utility" "bset"))
(:file "dictionary" :depends-on ())
(:file "dll" :depends-on ())
(:file "graph" :depends-on ("utility" "list"))
(:file "llrbtree" :depends-on ())
(:file "queue" :depends-on ("utility"))
(:file "message-queue" :depends-on ("queue"))
;; Standards:
(:file "ascii" :depends-on ())
(:file "character" :depends-on ("ascii"))
(:file "character-sets" :depends-on ("string"))
(:file "ecma048" :depends-on ("utility"))
(:file "iso3166" :depends-on ())
(:file "iso4217" :depends-on ())
(:file "iso639a" :depends-on ())
;; Algorithms:
(:file "pmatch" :depends-on ("utility"))
(:file "combination" :depends-on ())
(:file "constraints" :depends-on ("utility" "dictionary"))
(:file "raiden" :depends-on ())
(:file "dfa" :depends-on ())
(:file "tea" :depends-on ())
(:file "circular" :depends-on ())
(:file "histogram" :depends-on ())
;; Specific stuff:
(:file "activity" :depends-on ())
(:file "date" :depends-on ())
(:file "version" :depends-on ())
;; Files:
(:file "stream" :depends-on ("string"))
(:file "file" :depends-on ("stream" "ascii"))
(:file "peek-stream" :depends-on ())
(:file "cache" :depends-on ())
(:file "float-binio" :depends-on ())
))
:author "Pascal J. Bourguignon <[email protected]>"
:maintainer "Pascal J. Bourguignon <[email protected]>"
:licence "AGPL3"
;; component attributes:
:name "com.informatimago.common-lisp.cesarum"
:version "1.3.3"
:properties ((#:author-email . "[email protected]")
(#:date . "Autumn 2010")
((#:albert #:output-dir) . "/tmp/documentation/com.informatimago.common-lisp.cesarum/")
((#:albert #:formats) . ("docbook"))
((#:albert #:docbook #:template) . "book")
((#:albert #:docbook #:bgcolor) . "white")
((#:albert #:docbook #:textcolor) . "black"))
#+asdf-unicode :encoding #+asdf-unicode :utf-8
:depends-on ("com.informatimago.common-lisp.lisp-sexp")
:in-order-to ((test-op (test-op "com.informatimago.common-lisp.cesarum-test")))
:components (
;; Simple Test Framework
(:file "simple-test" :depends-on ())
;; Common Lisp addendum:
(:file "array" :depends-on ())
(:file "sequence" :depends-on ())
(:file "list" :depends-on ())
(:file "utility" :depends-on ("list"))
(:file "string" :depends-on ("utility" "list" "ecma048"))
(:file "package" :depends-on ("utility"))
;; Data structures:
(:file "set" :depends-on ("simple-test" "utility" "array"))
(:file "index-set" :depends-on ("simple-test" "utility" "array" "sequence" "set"))
(:file "bset" :depends-on ("utility" "set"))
(:file "brelation" :depends-on ("utility" "bset"))
(:file "dictionary" :depends-on ())
(:file "dll" :depends-on ())
(:file "graph" :depends-on ("utility" "list"))
(:file "llrbtree" :depends-on ())
(:file "queue" :depends-on ("utility"))
(:file "message-queue" :depends-on ("queue"))
;; Standards:
(:file "ascii" :depends-on ())
(:file "character" :depends-on ("ascii"))
(:file "character-sets" :depends-on ("string"))
(:file "ecma048" :depends-on ("utility"))
(:file "iso3166" :depends-on ())
(:file "iso4217" :depends-on ())
(:file "iso639a" :depends-on ())
;; Algorithms:
(:file "pmatch" :depends-on ("utility"))
(:file "combination" :depends-on ())
(:file "constraints" :depends-on ("utility" "dictionary"))
(:file "raiden" :depends-on ())
(:file "dfa" :depends-on ())
(:file "tea" :depends-on ())
(:file "circular" :depends-on ())
(:file "histogram" :depends-on ())
;; Specific stuff:
(:file "activity" :depends-on ())
(:file "date" :depends-on ())
(:file "version" :depends-on ())
;; Files:
(:file "stream" :depends-on ("string"))
(:file "file" :depends-on ("stream" "ascii"))
(:file "peek-stream" :depends-on ())
(:file "cache" :depends-on ())
(:file "float-binio" :depends-on ())
))
;; Would require a separate asd file...
......
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: index-set-test.lisp
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; The tests for index-set.lisp
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <[email protected]>
;;;;MODIFICATIONS
;;;; 2015-01-08 <PJB> Extracted from index-set.lisp
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2015 - 2015
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU Affero General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(in-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.INDEX-SET")
;;----------------------------------------------------------------------
;; RANGE TESTS
(define-test test/range ()
(assert-true (range-emptyp (make-range :start 1 :count 0)))
(assert-true (range-emptyp (make-range :start 1 :last 0)))
(assert-true (range-emptyp (make-range :start 1 :end 1)))
(assert-true (not (range-emptyp (make-range :start 1 :count 1))))
(assert-true (not (range-emptyp (make-range :start 1 :last 1))))
(assert-true (not (range-emptyp (make-range :start 1 :end 2))))
(assert-true (equal-range (make-range :start 10 :end 21)
(make-range :first 10 :last 20)))
(assert-true (equal-range (make-range :start 0 :end -1)
(make-range :first 0 :last -1)))
(test = (range-start (make-range :start 1 :count 3)) 1)
(test = (range-last (make-range :start 1 :count 3)) 3)
(test = (range-end (make-range :start 1 :count 3)) 4)
(test = (range-count (make-range :start 1 :count 3)) 3)
(test = (range-start (copy-range (make-range :start 1 :count 3))) 1)
(test = (range-last (copy-range (make-range :start 1 :count 3))) 3)
(test = (range-end (copy-range (make-range :start 1 :count 3))) 4)
(test = (range-count (copy-range (make-range :start 1 :count 3))) 3)
(test = (range-start (make-range :start 11 :last 13)) 11)
(test = (range-last (make-range :start 11 :last 13)) 13)
(test = (range-end (make-range :start 11 :last 13)) 14)
(test = (range-count (make-range :start 11 :last 13)) 3)
(test = (range-start (copy-range (make-range :start 11 :last 13))) 11)
(test = (range-last (copy-range (make-range :start 11 :last 13))) 13)
(test = (range-end (copy-range (make-range :start 11 :last 13))) 14)
(test = (range-count (copy-range (make-range :start 11 :last 13))) 3)
(test = (range-start (make-range :start 11 :end 14)) 11)
(test = (range-last (make-range :start 11 :end 14)) 13)
(test = (range-end (make-range :start 11 :end 14)) 14)
(test = (range-count (make-range :start 11 :end 14)) 3)
(test = (range-start (copy-range (make-range :start 11 :end 14))) 11)
(test = (range-last (copy-range (make-range :start 11 :end 14))) 13)
(test = (range-end (copy-range (make-range :start 11 :end 14))) 14)
(test = (range-count (copy-range (make-range :start 11 :end 14))) 3)
(test = (range-start (make-range :count 3 :last 13)) 11)
(test = (range-last (make-range :count 3 :last 13)) 13)
(test = (range-end (make-range :count 3 :last 13)) 14)
(test = (range-count (make-range :count 3 :last 13)) 3)
(test = (range-start (copy-range (make-range :count 3 :last 13))) 11)
(test = (range-last (copy-range (make-range :count 3 :last 13))) 13)
(test = (range-end (copy-range (make-range :count 3 :last 13))) 14)
(test = (range-count (copy-range (make-range :count 3 :last 13))) 3)
(test = (range-start (make-range :count 3 :end 14)) 11)
(test = (range-last (make-range :count 3 :end 14)) 13)
(test = (range-end (make-range :count 3 :end 14)) 14)
(test = (range-count (make-range :count 3 :end 14)) 3)
(test = (range-start (copy-range (make-range :count 3 :end 14))) 11)
(test = (range-last (copy-range (make-range :count 3 :end 14))) 13)
(test = (range-end (copy-range (make-range :count 3 :end 14))) 14)
(test = (range-count (copy-range (make-range :count 3 :end 14))) 3))
(define-test test/range/complement ()
(test equal-ranges
(complement-ranges (vector) 0 100)
(vector (make-range :start 0 :end 100)))
(test equal-ranges
(complement-ranges (vector (make-range :start 0 :end 100)) 0 100)
(vector))
(test equal-ranges
(complement-ranges (vector (make-range :start 0 :end 90)) 0 100)
(vector (make-range :start 90 :end 100)))
(test equal-ranges
(complement-ranges (vector (make-range :start 10 :end 100)) 0 100)
(vector (make-range :start 0 :end 10)))
(test equal-ranges
(complement-ranges (vector (make-range :start 10 :end 90)) 0 100)
(vector (make-range :start 0 :end 10) (make-range :start 90 :end 100)))
(expect-condition error
(complement-ranges (vector (make-range :start 0 :end 100)) 10 90)))
;;----------------------------------------------------------------------
;; INDEX-SET TESTS
(defun test/all ()
(test/range)
(test/range/complement)
(com.informatimago.common-lisp.cesarum.set::test/all/class 'index-set))
......@@ -161,66 +161,6 @@ License:
(and (= (range-start r1) (range-start r2))
(= (range-end r1) (range-end r2))))))
;;----------------------------------------------------------------------
;; RANGE TESTS
(define-test test/range ()
(assert-true (range-emptyp (make-range :start 1 :count 0)))
(assert-true (range-emptyp (make-range :start 1 :last 0)))
(assert-true (range-emptyp (make-range :start 1 :end 1)))
(assert-true (not (range-emptyp (make-range :start 1 :count 1))))
(assert-true (not (range-emptyp (make-range :start 1 :last 1))))
(assert-true (not (range-emptyp (make-range :start 1 :end 2))))
(assert-true (equal-range (make-range :start 10 :end 21)
(make-range :first 10 :last 20)))
(assert-true (equal-range (make-range :start 0 :end -1)
(make-range :first 0 :last -1)))
(test = (range-start (make-range :start 1 :count 3)) 1)
(test = (range-last (make-range :start 1 :count 3)) 3)
(test = (range-end (make-range :start 1 :count 3)) 4)
(test = (range-count (make-range :start 1 :count 3)) 3)
(test = (range-start (copy-range (make-range :start 1 :count 3))) 1)
(test = (range-last (copy-range (make-range :start 1 :count 3))) 3)
(test = (range-end (copy-range (make-range :start 1 :count 3))) 4)
(test = (range-count (copy-range (make-range :start 1 :count 3))) 3)
(test = (range-start (make-range :start 11 :last 13)) 11)
(test = (range-last (make-range :start 11 :last 13)) 13)
(test = (range-end (make-range :start 11 :last 13)) 14)
(test = (range-count (make-range :start 11 :last 13)) 3)
(test = (range-start (copy-range (make-range :start 11 :last 13))) 11)
(test = (range-last (copy-range (make-range :start 11 :last 13))) 13)
(test = (range-end (copy-range (make-range :start 11 :last 13))) 14)
(test = (range-count (copy-range (make-range :start 11 :last 13))) 3)
(test = (range-start (make-range :start 11 :end 14)) 11)
(test = (range-last (make-range :start 11 :end 14)) 13)
(test = (range-end (make-range :start 11 :end 14)) 14)
(test = (range-count (make-range :start 11 :end 14)) 3)
(test = (range-start (copy-range (make-range :start 11 :end 14))) 11)
(test = (range-last (copy-range (make-range :start 11 :end 14))) 13)
(test = (range-end (copy-range (make-range :start 11 :end 14))) 14)
(test = (range-count (copy-range (make-range :start 11 :end 14))) 3)
(test = (range-start (make-range :count 3 :last 13)) 11)
(test = (range-last (make-range :count 3 :last 13)) 13)
(test = (range-end (make-range :count 3 :last 13)) 14)
(test = (range-count (make-range :count 3 :last 13)) 3)
(test = (range-start (copy-range (make-range :count 3 :last 13))) 11)
(test = (range-last (copy-range (make-range :count 3 :last 13))) 13)
(test = (range-end (copy-range (make-range :count 3 :last 13))) 14)
(test = (range-count (copy-range (make-range :count 3 :last 13))) 3)
(test = (range-start (make-range :count 3 :end 14)) 11)
(test = (range-last (make-range :count 3 :end 14)) 13)
(test = (range-end (make-range :count 3 :end 14)) 14)
(test = (range-count (make-range :count 3 :end 14)) 3)
(test = (range-start (copy-range (make-range :count 3 :end 14))) 11)
(test = (range-last (copy-range (make-range :count 3 :end 14))) 13)
(test = (range-end (copy-range (make-range :count 3 :end 14))) 14)
(test = (range-count (copy-range (make-range :count 3 :end 14))) 3))
;;;=====================================================================
;;; INDEX-SET CLASS
......@@ -505,32 +445,6 @@ License:
(every (function equal-range) a b)))
(define-test test/range/complement ()
(test equal-ranges
(complement-ranges (vector) 0 100)
(vector (make-range :start 0 :end 100)))
(test equal-ranges
(complement-ranges (vector (make-range :start 0 :end 100)) 0 100)
(vector))
(test equal-ranges
(complement-ranges (vector (make-range :start 0 :end 90)) 0 100)
(vector (make-range :start 90 :end 100)))
(test equal-ranges
(complement-ranges (vector (make-range :start 10 :end 100)) 0 100)
(vector (make-range :start 0 :end 10)))
(test equal-ranges
(complement-ranges (vector (make-range :start 10 :end 90)) 0 100)
(vector (make-range :start 0 :end 10) (make-range :start 90 :end 100)))
(expect-condition error
(complement-ranges (vector (make-range :start 0 :end 100)) 10 90)))
;;----------------------------------------------------------------------
;; Functional
......@@ -684,16 +598,6 @@ License:
destination-set)
;;----------------------------------------------------------------------
;; INDEX-SET TESTS
(defun test/all ()
(test/range)
(test/range/complement)
(com.informatimago.common-lisp.cesarum.set::test/all/class 'index-set))
(test/all)
;; (copy 'index-set '(1 2 3 4))
;; (map-elements 'list 'identity (copy 'index-set '(1 2 3 4)))
;; (map-elements 'vector 'identity (copy 'index-set '(1 2 3 4)))
......
This diff is collapsed.
......@@ -551,239 +551,4 @@ RETURN: SET.
(reduce (function max) (slot-value set 'elements))))
;;;-----------------------------------------------------------------------
;;; TESTS
;;;-----------------------------------------------------------------------
(defun test-sets (test-class)
(list '() '(1) '(1 2 3)
'#() '#(1) '#(1 2 3)
(copy test-class '()) (copy test-class '(1)) (copy test-class '(1 2 3))))
(define-test test/all/nil ()
(loop
:for seq :in (test-sets 'list-set)
:do
(test eql (map-elements nil (function identity) seq) nil)
(test set-equal (let ((result '()))
(map-elements nil (lambda (element) (push element result)) seq)
result)
seq)))
(define-test test/map-elements (test-class)
(loop
:for set :in (test-sets test-class)
:do (loop
:for class :in (list 'list 'vector test-class)
:do (test set-equal (map-elements class (function identity) set)
(ecase (cardinal set)
(0 '())
(1 '(1))
(3 '(1 2 3)))))))
(define-test test/copy (test-class)
(loop
:for (expected type original)
:in (list (list nil 'nil '(1 2 3 4))
(list '(1 2 3 4) 'list '(1 2 3 4))
(list '(1 2 3 4) 'vector '(1 2 3 4))
(list '(1 2 3 4) test-class '(1 2 3 4)))
:do
(test set-equal (copy type original) expected (type original))
(test set-equal (copy 'list (copy type original)) expected (type original))
(test set-equal (copy 'vector (copy type original)) expected (type original))))
(define-test test/is-subseq (test-class1 test-class2)
(flet ((test-set1 (&rest elements)
(copy test-class1 elements))
(test-set2 (&rest elements)
(copy test-class2 elements)))
(assert-true (is-subset (test-set1)
(test-set2)))
(assert-true (is-subset (test-set1 1)
(test-set2 1)))
(assert-true (is-subset (test-set1 1 2 3)
(test-set2 1 2 3)))
(assert-true (is-subset (test-set1 1 2 3 11 12 13)
(test-set2 11 12 13 1 2 3)))
(assert-true (is-subset (test-set1)
(test-set2 1)))
(assert-true (not (is-subset (test-set1 1)
(test-set2))))
(assert-true (not (is-subset (test-set1 1)
(test-set2 2))))
(assert-true (is-subset (test-set1 1 2 3)
(test-set2 1 2 3 4)))
(assert-true (not (is-subset (test-set1 1 2 3 4)
(test-set2 1 2 3))))))
(define-test test/set-equal (test-class)
(flet ((test-set (&rest elements)
(copy test-class elements)))
(assert-true (set-equal (test-set)
(test-set)))
(assert-true (set-equal (test-set 1)
(test-set 1)))
(assert-true (set-equal (test-set 1 2 3)
(test-set 1 2 3)))
(assert-true (set-equal (test-set 1 2 3 11 12 13)
(test-set 11 12 13 1 2 3)))
(assert-true (not (set-equal (test-set)
(test-set 1))))
(assert-true (not (set-equal (test-set 1)
(test-set))))
(assert-true (not (set-equal (test-set 1)
(test-set 2))))
(assert-true (not (set-equal (test-set 1 2 3)
(test-set 1 2 3 4))))
(assert-true (not (set-equal (test-set 1 2 3 4)
(test-set 1 2 3))))))
(define-test test/union (operator test-class)
(flet ((test-set (&rest elements)
(copy test-class elements)))
(test set-equal (funcall operator
(test-set 1 2 3 7 8 10 11 12)
(test-set 1 2 3 7 8 10 11 12))
(test-set 1 2 3 7 8 10 11 12))
(test set-equal (funcall operator
(test-set)
(test-set 1 2 3 7 8 10 11 12))
(test-set 1 2 3 7 8 10 11 12))