Changeset 10344


Ignore:
Timestamp:
11/04/05 12:06:00 (16 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/tests/condition-tests.lisp

    r10331 r10344  
    2121(in-package #:test)
    2222
     23(defun filter (string)
     24  "If STRING is unreadable, return \"#<>\"; otherwise return STRING unchanged."
     25  (let ((len (length string)))
     26    (when (> len 3)
     27      (when (string= (subseq string 0 2) "#<")
     28        (when (char= (char string (1- len)) #\>)
     29          (setf string "#<>")))))
     30  string)
     31
     32(deftest condition.1
     33  (filter (write-to-string (make-condition 'condition) :escape t))
     34  "#<>")
     35
     36(deftest condition.2
     37  (filter (write-to-string (make-condition 'condition) :escape nil))
     38  #+(or abcl allegro)
     39  "#<>"
     40  #+clisp
     41  "Condition of type CONDITION."
     42  #+(or cmu sbcl)
     43  "Condition CONDITION was signalled.")
     44
     45#+(or abcl allegro)
     46(deftest condition.3
     47  (write-to-string (make-condition 'condition
     48                                   :format-control "The bear is armed.")
     49                   :escape nil)
     50  "The bear is armed.")
     51
    2352(deftest print-not-readable-object.1
    2453  (signals-error (slot-boundp (make-condition 'print-not-readable)
     
    4877  symbol)
    4978
    50 #+(or abcl clisp cmu sbcl)
    5179(deftest type-error.3
    52   (write-to-string (make-condition 'type-error :datum 42 :expected-type 'symbol)
    53                    :escape nil)
     80  (let ((c (make-condition 'type-error :datum 42 :expected-type 'symbol)))
     81    (filter (write-to-string c :escape nil)))
     82  #+allegro
     83  "#<>"
    5484  #+clisp
    5585  "Condition of type TYPE-ERROR."
     
    5989  "The value 42 is not of type SYMBOL.")
    6090
    61 #+(or abcl clisp cmu sbcl)
    6291(deftest type-error.4
    63   (format nil "~A" (make-condition 'type-error :datum 42 :expected-type 'symbol))
     92  (let ((c (make-condition 'type-error :datum 42 :expected-type 'symbol)))
     93    (filter (format nil "~A" c)))
     94  #+allegro
     95  "#<>"
    6496  #+clisp
    6597  "Condition of type TYPE-ERROR."
     
    185217  symbol)
    186218
    187 #+(or abcl clisp cmu sbcl)
     219#+(or abcl allegro)
    188220(deftest define-condition.3
    189221  (progn
    190222    (setf (find-class 'test-error) nil)
    191223    (define-condition test-error (type-error) ())
    192     (format nil "~A" (make-condition 'test-error :datum 42 :expected-type 'symbol)))
     224    (slot-boundp (make-condition 'test-error)
     225                 #+abcl    'system::format-control
     226                 #+allegro 'excl::format-control))
     227  nil)
     228
     229#+(or abcl allegro)
     230(deftest define-condition.4
     231  (progn
     232    (setf (find-class 'test-error) nil)
     233    (define-condition test-error (type-error) ())
     234    (simple-condition-format-arguments (make-condition 'test-error)))
     235  nil)
     236
     237(deftest define-condition.5
     238  (progn
     239    (setf (find-class 'test-error) nil)
     240    (define-condition test-error (type-error) ())
     241    (let ((c (make-condition 'test-error :datum 42 :expected-type 'symbol)))
     242      (filter (format nil "~A" c))))
     243  #+allegro
     244  "#<>"
    193245  #+clisp
    194246  "Condition of type TEST-ERROR."
     
    199251
    200252#+(or abcl clisp cmu sbcl)
    201 (deftest define-condition.4
    202   (progn
    203     (setf (find-class 'test-error) nil)
    204     (define-condition test-error (type-error) ())
    205     (write-to-string (make-condition 'test-error :datum 42 :expected-type 'symbol)
    206                      :escape nil))
     253(deftest define-condition.6
     254  (progn
     255    (setf (find-class 'test-error) nil)
     256    (define-condition test-error (type-error) ())
     257    (let ((c (make-condition 'test-error :datum 42 :expected-type 'symbol)))
     258      (filter (write-to-string c :escape nil))))
     259  #+allegro
     260  "#<>"
    207261  #+clisp
    208262  "Condition of type TEST-ERROR."
     
    212266  "The value 42 is not of type SYMBOL.")
    213267
     268#+(or abcl allegro)
     269(deftest define-condition.7
     270  (progn
     271    (setf (find-class 'test-error) nil)
     272    (define-condition test-error (type-error) ())
     273    (let ((c (make-condition 'test-error
     274                             :datum 42
     275                             :expected-type 'symbol
     276                             :format-control "The bear is armed.")))
     277      (write-to-string c :escape nil)))
     278  "The bear is armed.")
     279
     280#+(or abcl allegro)
     281(deftest define-condition.8
     282  (progn
     283    (setf (find-class 'test-error) nil)
     284    (define-condition test-error (type-error) ())
     285    (let ((c (make-condition 'test-error
     286                             :datum 42
     287                             :expected-type 'symbol
     288                             :format-control "~A is ~A."
     289                             :format-arguments (list "The bear" "armed"))))
     290      (write-to-string c :escape nil)))
     291  "The bear is armed.")
     292
     293#+(or abcl allegro)
     294(deftest define-condition.9
     295  (progn
     296    (setf (find-class 'test-error) nil)
     297    (define-condition test-error (condition) ())
     298    (let ((c (make-condition 'test-error
     299                             :format-control "The bear is armed.")))
     300      (write-to-string c :escape nil)))
     301  "The bear is armed.")
     302
     303#+(or abcl allegro)
     304(deftest define-condition.10
     305  (progn
     306    (setf (find-class 'test-error) nil)
     307    (define-condition test-error (condition) ())
     308    (let ((c (make-condition 'test-error
     309                             :format-control "~A is ~A."
     310                             :format-arguments (list "The bear" "armed"))))
     311      (write-to-string c :escape nil)))
     312  "The bear is armed.")
     313
    214314(do-tests)
Note: See TracChangeset for help on using the changeset viewer.