Fix compatibility issues with Allegro CL Modern mode

- change symbols to lower case
- wrap use-package forms in eval-when
- complement require forms with an ASDF system definition for tests

marshal-tests.asd

@@ -0,0 +1,15 @@
+;;; ***********************************************************
+;;;
+;;; Project: marshal
+;;; Simple (de)serialization of Lisp datastructures.
+;;;
+;;; ***********************************************************
+
+(asdf:defsystem #:marshal-tests
+  :description "marshal: Simple (de)serialization of Lisp datastructures."
+  :author "Michael Wolber <mwolber@gmx.de>"
+  :version "1.2"
+  :licence "MIT"
+  :depends-on (#:xlunit #:marshal)
+  :serial t
+  :components ((:file "tests")))

marshal.lisp

@@ -24,14 +24,14 @@ If this is a nested list, then the elements of the second level
 need to be pairs of slot and accessors."))
 
   (defmethod class-persistent-slots ((class standard-object))
-    NIL)
+    nil)
 
   (setf (symbol-function 'class-persistant-slots) #'class-persistent-slots))
 
 ;;; =============================================================
 
 (defclass persist-hashtable ()
-  ((hashtable :initform NIL :accessor hashtable)
+  ((hashtable :initform nil :accessor hashtable)
    (next-key :initform 0 :accessor next-key)))
 
 (defmethod initialize-instance :after ((self persist-hashtable) &rest initargs)
@@ -69,12 +69,12 @@ to send it over a network or to store it in a database etc.")
   )
 
 
-(defmethod marshal (thing &optional (circle-hash NIL))
+(defmethod marshal (thing &optional (circle-hash nil))
   (declare (ignore circle-hash))
   thing)
 
 
-(defmethod marshal :around (thing &optional (circle-hash NIL))
+(defmethod marshal :around (thing &optional (circle-hash nil))
   (if circle-hash
       (call-next-method thing circle-hash)
       (progn
@@ -83,11 +83,11 @@ to send it over a network or to store it in a database etc.")
       ))
 
 
-(defmethod marshal ((object standard-object) &optional (circle-hash NIL))
+(defmethod marshal ((object standard-object) &optional (circle-hash nil))
   (let* ((class   (class-of object))
          (pslots  (class-persistent-slots object))
-         (dummy   NIL)
-         (outlist NIL))
+         (dummy   nil)
+         (outlist nil))
     (setq dummy (getvalue circle-hash object))
     (if dummy
         (setq outlist (list (coding-idiom :reference) dummy))
@@ -114,9 +114,9 @@ to send it over a network or to store it in a database etc.")
   (push (coding-idiom key-idiom) output))
 
 ;;; 12.02.99 cjo: auch dotted lists werden korrekt behandelt
-(defmethod marshal ((list list) &optional (circle-hash NIL))
-  (let* ((ckey NIL)
-         (output NIL)
+(defmethod marshal ((list list) &optional (circle-hash nil))
+  (let* ((ckey nil)
+         (output nil)
 	 (circular-list-p (utils:circular-list-p list))
          (dotted-list-p   (and (not circular-list-p)
 			       (rest (last list)))))
@@ -158,10 +158,10 @@ to send it over a network or to store it in a database etc.")
 ;;;                :array moeglich
 ;;;  10.08.98 cjo: nreverse vergessen! push dreht die liste um. wenn es bloede laeuft hat man so
 ;;;                :reference, bevor die nummer ueberhaupt existiert!
-(defmethod marshal ((array array) &optional (circle-hash NIL))
-  (let* ((ckey NIL)
-         (output NIL)
-         (dummy NIL))
+(defmethod marshal ((array array) &optional (circle-hash nil))
+  (let* ((ckey nil)
+         (output nil)
+         (dummy nil))
     (setf ckey (getvalue circle-hash array))
     (if ckey
         (setq output (list (coding-idiom :reference) ckey))
@@ -178,8 +178,8 @@ to send it over a network or to store it in a database etc.")
 (defgeneric marshal-simple-string (object circle-hash))
 
 (defmethod marshal-simple-string (object circle-hash)
-  (let* ((ckey NIL)
-         (output NIL))
+  (let* ((ckey nil)
+         (output nil))
     (setf ckey (getvalue circle-hash object))
     (if ckey
         (setq output (list (coding-idiom :reference) ckey))
@@ -191,33 +191,33 @@ to send it over a network or to store it in a database etc.")
     output))
 
 (defun marshal-string (object circle-hash)
-  (let* ((ckey NIL)
-         (output NIL))
+  (let* ((ckey nil)
+         (output nil))
     (setf ckey (getvalue circle-hash object))
     (if ckey
         (setq output (list (coding-idiom :reference) ckey))
         (let ((fill-pointer (if (array-has-fill-pointer-p object) (fill-pointer object) nil))
               (adjustable-array-p (adjustable-array-p object)))
           (setq ckey (genkey circle-hash))
           (setvalue circle-hash object ckey)
-          (when fill-pointer (setf (fill-pointer object) (array-dimension object 0))) ; was 0, was: NIL
+          (when fill-pointer (setf (fill-pointer object) (array-dimension object 0))) ; was 0, was: nil
           (setq output (list (coding-idiom :string) ckey
                              fill-pointer
                              adjustable-array-p
                              (princ-to-string object)))
           (when fill-pointer (setf (fill-pointer object) fill-pointer))))
     output))
 
-(defmethod marshal ((object string) &optional (circle-hash NIL))
+(defmethod marshal ((object string) &optional (circle-hash nil))
   (typecase object
     (simple-string (marshal-simple-string object circle-hash))
-    (T             (marshal-string object circle-hash))))
+    (t             (marshal-string object circle-hash))))
 
 ;;; cjo 15.1.1999 hash-function kann man nicht mehr auslesen!!!
-(defmethod marshal ((hash-table hash-table) &optional (circle-hash NIL))
-  (let* ((ckey NIL)
-         (output NIL)
-         (dummy NIL))
+(defmethod marshal ((hash-table hash-table) &optional (circle-hash nil))
+  (let* ((ckey nil)
+         (output nil)
+         (dummy nil))
     (setf ckey (getvalue circle-hash hash-table))
     (if ckey
         (setq output (list (coding-idiom :reference) ckey))
@@ -228,7 +228,7 @@ to send it over a network or to store it in a database etc.")
                              (hash-table-size hash-table) (hash-table-rehash-size hash-table)
                              (hash-table-rehash-threshold hash-table) (hash-table-test hash-table)
                              ;;(hash-table-hash-function hash-table)
-                             NIL
+                             nil
                              ))
           (maphash #'(lambda (key value)
                        (setq dummy

tests.lisp

@@ -15,13 +15,17 @@
 
 (in-package :cl-user)
 
+#-allegro
 (require :marshal)
 
+#-allegro
 (require :xlunit)
 
-(use-package :xlunit)
+(eval-when (:compile-toplevel)
+  (use-package :xlunit))
 
-(use-package :marshal)
+(eval-when (:compile-toplevel)
+  (use-package :marshal))
 
 ;;; ***********************************************************
 ;; definition of test classes
@@ -30,7 +34,7 @@
    (dimensions :initform '(:width 0 :length 0) :initarg :dimensions :accessor dimensions)
    (course :initform 0 :initarg :course :accessor course)
    (cruise :initform 0 :initarg :cruise :accessor cruise) ; shall be transient
-   (dinghy :initform NIL :initarg :dinghy :accessor dinghy)) ; another ship -> ref
+   (dinghy :initform nil :initarg :dinghy :accessor dinghy)) ; another ship -> ref
   (:documentation "A democlass. Some 'persistent slots', one transient.
 Some numbers, string, lists and object references."))
 
@@ -67,7 +71,7 @@ Some numbers, string, lists and object references."))
   )
 
 (defclass dinghy (ship)
-  ((aboard :initform NIL :initarg :aboard :accessor aboard)) ; another ship -> circular ref
+  ((aboard :initform nil :initarg :aboard :accessor aboard)) ; another ship -> circular ref
   )
 
 ;; note: intentionally misspelled
@@ -112,11 +116,11 @@ Some numbers, string, lists and object references."))
   )
 
 (def-test-method test-objectref ((self objecttest) :run nil)
-  (assert-equal '(:PCODE 1
-		  (:OBJECT 1 MOTORSHIP :COMMON-LISP-USER (:SIMPLE-STRING 2 "Titanic")
-		   (:LIST 3 :WIDTH 28 :LENGTH 269) 320
-		   (:OBJECT 4 DINGHY :COMMON-LISP-USER (:SIMPLE-STRING 5 "Gig")
-		    (:LIST 6 :WIDTH 2 :LENGTH 6) 320 (:LIST 7) (:REFERENCE 7))))
+  (assert-equal '(:pcode 1
+		  (:object 1 motorship :common-lisp-user (:simple-string 2 "Titanic")
+		   (:list 3 :width 28 :length 269) 320
+		   (:object 4 dinghy :common-lisp-user (:simple-string 5 "Gig")
+		    (:list 6 :width 2 :length 6) 320 (:list 7) (:reference 7))))
 		(marshal (ship3 self))))
 
 (def-test-method test-objectcircle ((self objecttest) :run nil)