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

Corrections for MOCL.

parent 2a0228d8
......@@ -32,6 +32,32 @@
;;;; along with this program. If not, see http://www.gnu.org/licenses/
;;;;**************************************************************************
#+mocl
(asdf:defsystem "com.informatimago.clext.association"
;; system attributes:
:description "Dummy Informatimago Common Lisp Extensions: Associations."
:long-description "
This system would use CLOSER-MOP, which is not available on MOCL.
"
: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 . "Autumn 2010")
((#:albert #:output-dir) . "/tmp/documentation/com.informatimago.clext/")
((#: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 ())
#-mocl
(asdf:defsystem "com.informatimago.clext.association"
;; system attributes:
:description "Informatimago Common Lisp Extensions: Associations."
......
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: ascii-test.lisp
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; Tests ascii.lisp.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2015-02-26 <PJB> Extracted from ascii.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/>.
;;;;**************************************************************************
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.ASCII.TEST"
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SIMPLE-TEST"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.ASCII")
(:export "TEST/ALL"))
(in-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.ASCII.TEST")
(define-test test/ascii ()
"
DO: test the ascii package; signal an error if something is wrong.
RETURN: :success
"
(loop
:for ch :across *ascii-characters*
:for code :from sp
:do (assert-true (= code (ascii-code ch)))
:do (assert-true (char= ch (code-ascii code))))
(loop
:for code :from (ascii-code #\0) :to (ascii-code #\9)
:for n :from 0
:do (assert-true (eql n (code-ascii-digit-p code))))
(assert-true (typep (nth-value 1 (ignore-errors (ascii-string #(65 66 8 67 69)))) 'decoding-error))
(assert-true (typep (nth-value 1 (ignore-errors (ascii-bytes "En été, il fait chaud."))) 'encoding-error))
(assert-true (string= "ABCD" (ascii-string #(65 66 67 68))))
(assert-true (string= "ABCD" (ascii-string #(0 0 65 66 67 68 0 0 0 0) :start 2 :end 6)))
(assert-true (bytes= #(65 66 67 68) (ascii-bytes "ABCD")))
(assert-true (bytes= #(65 66 67 68) (ascii-bytes "00ABCD0000" :start 2 :end 6)))
(let ((*readtable* (copy-readtable nil)))
(set-dispatch-macro-character #\# #\Y (function ascii-dispatch-macro)
*readtable*)
(set-dispatch-macro-character #\# #\" (function ascii-dispatch-macro)
*readtable*)
(assert-true (bytes= #(65 66 67 68) (read-from-string "#\"ABCD\"")))
(assert-true (bytes= #(65 66 67 68) (read-from-string "#Y\"ABCD\""))))
#| TODO: Added more testing of bytes comparisons.|#)
(define-test test/all ()
(test/ascii))
;;;; THE END ;;;;
......@@ -34,7 +34,6 @@
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>
;;;;**************************************************************************
(in-package "COMMON-LISP-USER")
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.ASCII"
(:use "COMMON-LISP")
(:export
......@@ -477,38 +476,4 @@ like string<, but for byte vectors.
(not (bytes<= v1 v2 :start1 start1 :end1 end1 :start2 start2 :end2 end2)))
(defun test ()
"
DO: test the ascii package; signal an error if something is wrong.
RETURN: :success
"
(loop
:for ch :across *ascii-characters*
:for code :from sp
:do (assert (= code (ascii-code ch)))
:do (assert (char= ch (code-ascii code))))
(loop
:for code :from (ascii-code #\0) :to (ascii-code #\9)
:for n :from 0
:do (assert (eql n (code-ascii-digit-p code))))
(assert (typep (nth-value 1 (ignore-errors (ascii-string #(65 66 8 67 69)))) 'decoding-error))
(assert (typep (nth-value 1 (ignore-errors (ascii-bytes "En été, il fait chaud."))) 'encoding-error))
(assert (string= "ABCD" (ascii-string #(65 66 67 68))))
(assert (string= "ABCD" (ascii-string #(0 0 65 66 67 68 0 0 0 0) :start 2 :end 6)))
(assert (bytes= #(65 66 67 68) (ascii-bytes "ABCD")))
(assert (bytes= #(65 66 67 68) (ascii-bytes "00ABCD0000" :start 2 :end 6)))
(let ((*readtable* (copy-readtable nil)))
(set-dispatch-macro-character #\# #\Y (function ascii-dispatch-macro)
*readtable*)
(set-dispatch-macro-character #\# #\" (function ascii-dispatch-macro)
*readtable*)
(assert (bytes= #(65 66 67 68) (read-from-string "#\"ABCD\"")))
(assert (bytes= #(65 66 67 68) (read-from-string "#Y\"ABCD\""))))
;; TODO: Added more testing of bytes comparisons.
:success)
(test)
;;;; THE END ;;;;
......@@ -66,6 +66,7 @@
(:file "peek-stream-test" :depends-on ())
(:file "priority-queue-test" :depends-on ())
(:file "sequence-test" :depends-on ())
(:file "ascii-test" :depends-on ())
(:file "string-test" :depends-on ())
(:file "set-test" :depends-on ())
(:file "index-set-test" :depends-on ("set-test")))
......@@ -83,7 +84,8 @@
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SEQUENCE.TEST"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING.TEST"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SET.TEST"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.INDEX-SET.TEST"))
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.INDEX-SET.TEST"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.ASCII.TEST"))
(let ((*package* (find-package p)))
(uiop:symbol-call p "TEST/ALL")))))
......
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -104,7 +104,6 @@
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>
;;;;****************************************************************************
(in-package "COMMON-LISP-USER")
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.PACKAGE"
(:documentation
"
......@@ -329,15 +328,24 @@ to the package path: PACKAGE:COM;INFORMATIMAGO;COMMON-LISP;SYSTEM.ASD
(values (when (probe-file file) file) file)))))
(defvar *built-in-packages*
(mapcan (lambda (pack)
(cons (package-name pack)
(copy-list (package-nicknames pack))))
(list-all-packages)))
(defvar *built-in-package-names*
'("COMMON-LISP" "CL" "COMMON-LISP-USER" "CL-USER" "KEYWORD"))
(defun built-in-p (package)
(member package *built-in-packages* :test (function string=)))
#-(and) (unless *built-in-package-names*
(setf *built-in-package-names*
(mapcan (lambda (pname)
(let ((pack (find-package pname)))
(when pack
(cons (package-name pack)
(copy-list (package-nicknames pack))))))
'("COMMON-LISP" "COMMON-LISP-USER" "KEYWORD"))))
(member (etypecase package
(string package)
(package (package-name package)))
*built-in-package-names*
:test (function string=)))
(defvar *packages* nil
......@@ -427,6 +435,9 @@ DO: Force registering the PACKAGE into the loaded *PACKAGES*.
path))
#+mocl (defvar *load-verbose* nil)
#+mocl (defvar *load-print* nil)
(defun load-package (package-name
&key (verbose *load-verbose*) (print *load-print*)
(if-does-not-exist :error)
......@@ -672,7 +683,7 @@ RETURN: The package designated by PACKAGE.
(rename-package pack temp nicks)
(rename-package pack packname nicks))
(when (built-in-p packname)
(pushnew nickname *built-in-packages* :test (function string=))))
(pushnew nickname *built-in-package-names* :test (function string=))))
((and force (string= nickname (package-name nickpack)))
(let ((nicks (or (package-nicknames nickpack)
(list (gen-old-name nickname)))))
......
......@@ -114,6 +114,9 @@ License:
(values))
#+mocl (defvar *load-verbose* nil)
#+mocl (defvar *load-print* nil)
(defun verbose (default)
(and default
(or (not *load-pathname*)
......
......@@ -81,7 +81,7 @@ License:
(in-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STREAM")
(defun stream-to-string-list (stream)
"
......@@ -89,8 +89,8 @@ RETURN: the list of lines collected from stream.
"
(typecase stream
(stream (loop
:for line = (read-line stream nil nil)
:while line :collect line))
:for line = (read-line stream nil nil)
:while line :collect line))
(string (split-string stream (format nil "~C" #\newline)))
(otherwise nil)))
......@@ -147,7 +147,7 @@ RETURN: A vector containing the elements read from the STREAM.
(+ busize max-extend))
start end))
(adjust-array buffer busize :initial-element initel :fill-pointer t))))))
(defun copy-over (stream from-pos to-pos &key (element-type 'character))
......@@ -179,12 +179,16 @@ NOTE: The file is not truncated.
(:documentation "RETURN: A simple INPUT-STREAM.")
(:method ((stream stream))
stream)
#-mocl
(:method ((stream concatenated-stream))
(stream-input-stream (first (concatenated-stream-streams stream))))
#-mocl
(:method ((stream echo-stream))
(stream-input-stream (echo-stream-input-stream stream)))
#-mocl
(:method ((stream synonym-stream))
(stream-input-stream (symbol-value (synonym-stream-symbol stream))))
#-mocl
(:method ((stream two-way-stream))
(stream-input-stream (two-way-stream-input-stream stream))))
......@@ -193,12 +197,16 @@ NOTE: The file is not truncated.
(:documentation "RETURN: A simple OUTPUT-STREAM.")
(:method ((stream stream))
stream)
#-mocl
(:method ((stream broadcast-stream))
(stream-output-stream (first (broadcast-stream-streams stream))))
#-mocl
(:method ((stream echo-stream))
(stream-input-stream (echo-stream-output-stream stream)))
#-mocl
(:method ((stream synonym-stream))
(stream-input-stream (symbol-value (synonym-stream-symbol stream))))
#-mocl
(:method ((stream two-way-stream))
(stream-input-stream (two-way-stream-output-stream stream))))
......@@ -242,21 +250,27 @@ RETURN: A stream or a list of streams that are not compound streams
"
(etypecase stream
#-mocl
(echo-stream
(ecase direction
(:output (bare-stream (echo-stream-output-stream stream)
:direction direction))
(:input (bare-stream (echo-stream-input-stream stream)
:direction direction))))
#-mocl
(two-way-stream
(ecase direction
(:output (bare-stream (two-way-stream-output-stream stream)
:direction direction))
(:input (bare-stream (two-way-stream-input-stream stream)
:direction direction))))
#-mocl
(synonym-stream
(bare-stream (symbol-value (synonym-stream-symbol stream))
:direction direction))
:direction direction))
#-mocl
(broadcast-stream
(remove-if-not
(lambda (stream)
......@@ -308,8 +322,8 @@ RETURN: A stream or a list of streams that are not compound streams
(defmacro with-output-to-byte-vector ((var &optional byte-vector-form
&key element-type) &body body)
"
&key element-type) &body body)
"
DO: Execute the BODY with VAR bound to an output byte vector
stream. If BYTE-VECTOR-FORM is given it should produce a byte
......@@ -319,15 +333,15 @@ ELEMENT-TYPE: The type of bytes. If BYTE-VECTOR-FORM is nil, one can
choose a different element-type for the byte vector.
RETURN: The byte vector written.
"
`(let ((,var (make-instance 'bvstream-out
,@(cond
(byte-vector-form
`(:bytes ,byte-vector-form))
(element-type
`(:bytes (make-array '(1024)
:element-type ,element-type
:adjustable t
:fill-pointer 0)))))))
`(let ((,var (make-instance 'bvstream-out
,@(cond
(byte-vector-form
`(:bytes ,byte-vector-form))
(element-type
`(:bytes (make-array '(1024)
:element-type ,element-type
:adjustable t
:fill-pointer 0)))))))
(let ((,var ,var)) ,@body)
(get-bytes ,var)))
......@@ -352,7 +366,7 @@ RETURN: The byte vector written.
(min (slot-value self 'end) len) len)
(bis-position self) (max 0 (min (bis-position self) len))))
self)
(defmethod bvstream-position ((self bvstream-in) position)
(if position
......
......@@ -88,11 +88,6 @@ License:
(in-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING")
(eval-when (:compile-toplevel :load-toplevel :execute)
(let ((*compile-verbose* nil))
(com.informatimago.common-lisp.cesarum.ecma048:generate-all-functions-in-ecma048)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun symbol-of-name-of-length=n (n)
......
......@@ -74,11 +74,6 @@ License:
(in-package "COM.INFORMATIMAGO.COMMON-LISP.CSV.CSV")
(eval-when (:compile-toplevel :load-toplevel :execute)
(let ((*compile-verbose* nil))
(com.informatimago.common-lisp.cesarum.ecma048:generate-all-functions-in-ecma048)))
;; http://planet.plt-scheme.org/docs/neil/csv.plt/1/0/doc.txt
......
This diff is collapsed.
......@@ -39,6 +39,7 @@
(declaim (also-use-packages "COM.INFORMATIMAGO.COMMON-LISP.HTML-GENERATOR.HTML"
"COM.INFORMATIMAGO.COMMON-LISP.HTTP.HQUERY"))
#-mocl
(eval-when (:compile-toplevel :load-toplevel :execute)
(com.informatimago.common-lisp.cesarum.package:add-nickname
"COM.INFORMATIMAGO.COMMON-LISP.HTML-GENERATOR.HTML" "HTML"))
......
......@@ -56,11 +56,12 @@ Beane's zpack.lisp).
((#:albert #:docbook #:textcolor) . "black"))
#+asdf-unicode :encoding #+asdf-unicode :utf-8
:depends-on ("com.informatimago.common-lisp.lisp-sexp")
:components ((:file "reader" :depends-on ())
:components (;; (:file "reader" :depends-on ())
(:file "package-pac" :depends-on ())
(:file "package-mac" :depends-on ("package-pac"))
(:file "package-fun" :depends-on ("package-pac" "package-mac"))
(:file "package-def" :depends-on ("package-pac" "package-mac" "package-fun")))
(:file "package-def" :depends-on ("package-pac" "package-mac" "package-fun"))
)
:in-order-to ((asdf:test-op (asdf:test-op "com.informatimago.common-lisp.lisp-reader.test"))))
;;;; THE END ;;;;
......@@ -50,12 +50,14 @@
#+asdf-unicode :encoding #+asdf-unicode :utf-8
:depends-on ("com.informatimago.common-lisp.cesarum"
"com.informatimago.common-lisp.lisp-reader")
:components ((:file "reader-test" :depends-on ()))
:components ((:file "reader-test" :depends-on ())
(:file "package-test" :depends-on ()))
:perform (asdf:test-op
(o s)
(let ((*package* (find-package "COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.READER.TEST")))
(uiop:symbol-call "COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.READER.TEST"
"TEST/ALL"))))
(dolist (p '("COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.READER.TEST"
"COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.PACKAGE.TEST"))
(let ((*package* (find-package p)))
(uiop:symbol-call p "TEST/ALL")))))
;;;; THE END ;;;;
......@@ -66,12 +66,12 @@
(cl:in-package "COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.PACKAGE")
;; with COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.PACKAGE
(defpackage "KEYWORD"
(:use)
(:documentation "The KEYWORD package."))
;; with COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.PACKAGE
(defpackage "COMMON-LISP"
(:use)
(:nicknames "CL")
......@@ -307,17 +307,17 @@
"WRITE-STRING" "WRITE-TO-STRING" "Y-OR-N-P" "YES-OR-NO-P" "ZEROP")
(:documentation "The COMMON-LISP package."))
;; with COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.PACKAGE
(defpackage "COMMON-LISP-USER"
(:use "COMMON-LISP")
(:nicknames "CL-USER")
(:documentation "The COMMON-LISP-USER package."))
(setf *keyword-package* (find-package "KEYWORD")
*common-lisp-package* (find-package "COMMON-LISP")
*common-lisp-user-package* (find-package "COMMON-LISP-USER")
*package* *common-lisp-user-package*)
(eval-when (:execute :load-toplevel #-mocl :compile-toplevel)
(setf *keyword-package* (find-package "KEYWORD")
*common-lisp-package* (find-package "COMMON-LISP")
*common-lisp-user-package* (find-package "COMMON-LISP-USER")
*package* *common-lisp-user-package*))
;;;; THE END ;;;;
......@@ -265,6 +265,17 @@ URL: <http://www.lispworks.com/documentation/HyperSpec/Body/v_pkg.htm>
(define-condition simple-type-error (simple-error-mixin type-error)
())
(define-condition print-not-readable (error)
((object :initarg :object :reader print-not-readable-object
:initform (error "Missing :object initarg.")))
(:report (lambda (condition stream)
(let ((*print-readably* nil)
(*print-circle* t)
(*print-length* 4)
(*print-level* 4))
(format stream "The object ~S is not printable readably."
(print-not-readable-object condition))))))
(defgeneric package-error-package (package-error)
(:documentation "
......@@ -1517,37 +1528,6 @@ IF-PACKAGE-EXISTS The default is :PACKAGE
nil)
(assert (null (check-disjoints (list "S1" "S2" "S3")
(list (list "P1" (list "P1A" "P1B" "P1C"))
(list "P2" (list "P2A" "P2B" "P2C")))
(list (list "P3" (list "I1A" "I1B" "I1C"))
(list "P4" (list "I2A" "I2B" "I2C")))
(list "I1" "I2" "I3")
(list "E1" "E2" "E3"))))
(assert (null (check-disjoints (list "S1" "S2" "S3")
'()
(list (list "P3" (list "I1A" "I1B" "I1C"))
(list "P4" (list "I2A" "I2B" "I2C")))
'()
(list "E1" "E2" "E3"))))
(assert (nth-value 1 (ignore-errors (check-disjoints (list "S1" "S2" "S3")
(list (list "P1" (list "P1A" "P1B" "P1C"))
(list "P2" (list "P2A" "P2B" "P2C" "S3")))
(list (list "P3" (list "I1A" "I1B" "I1C"))
(list "P4" (list "I2A" "I2B" "I2C")))
(list "I1" "I2" "I3")
(list "E1" "E2" "E3")))))
(assert (null (check-disjoints (list "S1" "S2" "S3")
(list (list "P1" (list "P1A" "P1B" "P1C"))
(list "P2" (list "P2A" "P2B" "P2C")))
(list (list "P3" (list "I1A" "I1B" "I1C"))
(list "P4" (list "I2A" "I2B" "I2C")))
(list "I1" "I2" "I3")
(list "E1" "E2" "E3" "S2"))))
(defun %define-package (name shadows shadowing-imports
uses imports interns exports
......@@ -1595,11 +1575,6 @@ IF-PACKAGE-EXISTS The default is :PACKAGE
(defun classify-per-package (symbols)
(let ((table (make-hash-table))
(result '()))
......
......@@ -109,20 +109,6 @@ URL: <http://www.lispworks.com/documentation/HyperSpec/Body/m_w_pkg_.htm>
:while (and (listp item) (eql 'declare (car item)))
:finally (return items)))
(assert (equal (mapcar (lambda (body) (list (declarations body) (body body)))
'(()
((declare (ignore x)))
((declare (ignore x)) (declare (ignore y)))
((print w) (print z))
((declare (ignore x)) (print w) (print z))
((declare (ignore x)) (declare (ignore y)) (print w) (print z))))
'((nil nil)
(((declare (ignore x))) nil)
(((declare (ignore x)) (declare (ignore y))) nil)
(nil ((print w) (print z)))
(((declare (ignore x))) ((print w) (print z)))
(((declare (ignore x)) (declare (ignore y))) ((print w) (print z))))))
(defun generate-do-symbols-loop (var package result-form body symbol-types)
(let ((iter (gensym "ITERATOR"))
......@@ -259,7 +245,7 @@ URL: <http://www.lispworks.com/documentation/HyperSpec/Body/m_defpkg.htm>
(interns (extract-strings :intern))
(exports (extract-strings :export)))
(check-disjoints shadows shadowing-imports import-froms interns exports)
`(eval-when (:execute :compile-toplevel :load-toplevel)
`(eval-when (:execute :load-toplevel #-mocl :compile-toplevel)
(%define-package ',(normalize-string-designator defined-package-name :if-not-a-string-designator :replace)
',shadows
',shadowing-imports
......@@ -270,4 +256,5 @@ URL: <http://www.lispworks.com/documentation/HyperSpec/Body/m_defpkg.htm>
',(extract-one-string :documentation)
',(extract-strings :nicknames))))))
;;;; THE END ;;;;
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.PACKAGE.TEST"
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SIMPLE-TEST"
"COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.PACKAGE")
(:export "TEST/ALL"))
(in-package "COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.PACKAGE.TEST")
(define-test test/check-disjoints ()
(assert-true (null (check-disjoints (list "S1" "S2" "S3")
(list (list "P1" (list "P1A" "P1B" "P1C"))
(list "P2" (list "P2A" "P2B" "P2C")))
(list (list "P3" (list "I1A" "I1B" "I1C"))
(list "P4" (list "I2A" "I2B" "I2C")))
(list "I1" "I2" "I3")
(list "E1" "E2" "E3"))))
(assert-true (null (check-disjoints (list "S1" "S2" "S3")
'()
(list (list "P3" (list "I1A" "I1B" "I1C"))
(list "P4" (list "I2A" "I2B" "I2C")))
'()
(list "E1" "E2" "E3"))))
(assert-true (nth-value 1 (ignore-errors (check-disjoints (list "S1" "S2" "S3")
(list (list "P1" (list "P1A" "P1B" "P1C"))
(list "P2" (list "P2A" "P2B" "P2C" "S3")))
(list (list "P3" (list "I1A" "I1B" "I1C"))
(list "P4" (list "I2A" "I2B" "I2C")))
(list "I1" "I2" "I3")
(list "E1" "E2" "E3")))))
(assert-true (null (check-disjoints (list "S1" "S2" "S3")
(list (list "P1" (list "P1A" "P1B" "P1C"))
(list "P2" (list "P2A" "P2B" "P2C")))
(list (list "P3" (list "I1A" "I1B" "I1C"))
(list "P4" (list "I2A" "I2B" "I2C")))
(list "I1" "I2" "I3")
(list "E1" "E2" "E3" "S2")))))
(define-test test/declarations/body ()
(assert-true (equal (mapcar (lambda (body) (list (declarations body) (body body)))
'(()
((declare (ignore x)))
((declare (ignore x)) (declare (ignore y)))
((print w) (print z))
((declare (ignore x)) (print w) (print z))
((declare (ignore x)) (declare (ignore y)) (print w) (print z))))
'((nil nil)
(((declare (ignore x))) nil)
(((declare (ignore x)) (declare (ignore y))) nil)
(nil ((print w) (print z)))
(((declare (ignore x))) ((print w) (print z)))
(((declare (ignore x)) (declare (ignore y))) ((print w) (print z)))))))
(define-test test/all ()
(test/check-disjoints)
(test/declarations/body))
;;;; THE END ;;;;
......@@ -42,7 +42,6 @@
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>
;;;;**************************************************************************
(in-package "COMMON-LISP-USER")
(defpackage "COM.INFORMATIMAGO.COMMON-LISP.LISP-READER.READER"
(:use "COMMON-LISP"
"COM.INFORMATIMAGO.COMMON-LISP.LISP-SEXP.SOURCE-FORM")
......
......@@ -570,7 +570,7 @@ some constraints may be different from one lambda-list to the other."))
(defclass type-lambda-list (lambda-list orakawbe-ll) ())
(defclass destructuring-lambda-list (lambda-list orakawb-ll) ())
(defclass setf-lambda-list (lambda-list orake-ll) ())
(defclass method-combination-lambda-list (lambda-list orakaw-ll) ())
(defclass method-combination-lambda-list (lambda-list oraka-ll) ())
(defgeneric lambda-list-kind (lambda-list)
(:method ((self ordinary-lambda-list)) (declare (ignorable self)) :ordinary)
......
......@@ -87,10 +87,6 @@ License:
(in-package "COM.INFORMATIMAGO.COMMON-LISP.RFC2822.RFC2822")
(eval-when (:compile-toplevel :load-toplevel :execute)
(let ((*compile-verbose* nil)) (com.informatimago.common-lisp.cesarum.ecma048:generate-all-functions-in-ecma048)))
(defparameter +space+ (character " ") "An ASCII SPACE character.")
(defparameter +tab+ (code-char com.informatimago.common-lisp.cesarum.ecma048:ht) "An ASCII TABULATION character.")
(defparameter +cr+ (code-char com.informatimago.common-lisp.cesarum.ecma048:cr) "An ASCII CARRIAGE-RETURN.")
......
......@@ -96,10 +96,6 @@ License:
(in-package "COM.INFORMATIMAGO.COMMON-LISP.UNIX.ALIASES")
(eval-when (:compile-toplevel :load-toplevel :execute)