tests.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: kmrcl-tests -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          kmrcl-tests.lisp
   6 ;;;; Purpose:       kmrcl tests file
   7 ;;;; Author:        Kevin M. Rosenberg
   8 ;;;; Date Started:  Apr 2003
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file is Copyright (c) 2000-2006 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; *************************************************************************
  15
  16 (in-package #:cl)
  17 (defpackage #:kmrcl-tests
  18   (:use #:kmrcl #:cl #:rtest))
  19 (in-package #:kmrcl-tests)
  20
  21 (rem-all-tests)
  22
  23
  24 (deftest :str.0 (substitute-chars-strings "" nil) "")
  25 (deftest :str.1 (substitute-chars-strings "abcd" nil) "abcd")
  26 (deftest :str.2 (substitute-chars-strings "abcd" nil) "abcd")
  27 (deftest :str.3 (substitute-chars-strings "abcd" '((#\j . "ef"))) "abcd")
  28 (deftest :str.4 (substitute-chars-strings "abcd" '((#\a . "ef"))) "efbcd")
  29 (deftest :str.5
  30     (substitute-chars-strings "abcd" '((#\a . "ef") (#\j . "ghi")))
  31   "efbcd")
  32 (deftest :str.6
  33     (substitute-chars-strings "abcd" '((#\a . "ef") (#\d . "ghi")))
  34   "efbcghi")
  35
  36 (deftest :str.7 (escape-xml-string "") "")
  37 (deftest :str.8 (escape-xml-string "abcd") "abcd")
  38 (deftest :str.9 (escape-xml-string "ab&cd") "ab&amp;cd")
  39 (deftest :str.10 (escape-xml-string "ab&cd<") "ab&amp;cd&lt;")
  40 (deftest :str.12 (string-trim-last-character "") "")
  41 (deftest :str.13 (string-trim-last-character "a") "")
  42 (deftest :str.14 (string-trim-last-character "ab") "a")
  43 (deftest :str.15 (nstring-trim-last-character "") "")
  44 (deftest :str.16 (nstring-trim-last-character "a") "")
  45 (deftest :str.17 (nstring-trim-last-character "ab") "a")
  46
  47 (deftest :str.18 (delimited-string-to-list "ab|cd|ef" #\|)
  48                                           ("ab" "cd" "ef"))
  49 (deftest :str.19 (delimited-string-to-list "ab|cd|ef" #\| t)
  50                                           ("ab" "cd" "ef"))
  51 (deftest :str.20 (delimited-string-to-list "") (""))
  52 (deftest :str.21 (delimited-string-to-list "" #\space t) (""))
  53 (deftest :str.22 (delimited-string-to-list "ab") ("ab"))
  54 (deftest :str.23 (delimited-string-to-list "ab" #\space t) ("ab"))
  55 (deftest :str.24 (delimited-string-to-list "ab|" #\|) ("ab" ""))
  56 (deftest :str.25 (delimited-string-to-list "ab|" #\| t) ("ab"))
  57
  58 (deftest :sdstl.1 (string-delimited-string-to-list "ab|cd|ef" "|a")
  59   ("ab|cd|ef"))
  60 (deftest :sdstl.2 (string-delimited-string-to-list "ab|cd|ef" "|")
  61   ("ab" "cd" "ef"))
  62 (deftest :sdstl.3 (string-delimited-string-to-list "ab|cd|ef" "cd")
  63   ("ab|" "|ef"))
  64 (deftest :sdstl.4 (string-delimited-string-to-list "ab|cd|ef" "ab")
  65   ("" "|cd|ef"))
  66
  67 (deftest :hexstr.1 (binary-sequence-to-hex-string ())
  68   "")
  69
  70 (deftest :hexstr.2 (binary-sequence-to-hex-string #())
  71   "")
  72
  73 (deftest :hexstr.3 (binary-sequence-to-hex-string #(165))
  74   "a5"
  75 )
  76
  77 (deftest :hexstr.4 (binary-sequence-to-hex-string (list 165))
  78   "a5")
  79
  80 (deftest :hexstr.5 (binary-sequence-to-hex-string #(165 86))
  81   "a556")
  82
  83 (deftest :apsl.1 (append-sublists '((a b) (c d))) (a b c d))
  84 (deftest :apsl.2 (append-sublists nil) nil)
  85 (deftest :apsl.3 (append-sublists '((a b))) (a b))
  86 (deftest :apsl.4 (append-sublists '((a))) (a))
  87 (deftest :apsl.5 (append-sublists '((a) (b) (c d (e f g)))) (a b c d (e f g)))
  88
  89 (deftest :pss.0 (with-output-to-string (s) (print-separated-strings s "|" nil))
  90   "")
  91
  92 (deftest :pss.1
  93     (with-output-to-string (s) (print-separated-strings s "|" '("ab")) )
  94   "ab")
  95
  96 (deftest :pss.2
  97     (with-output-to-string (s) (print-separated-strings s "|" '("ab" "cd")))
  98     "ab|cd")
  99
 100 (deftest :pss.3
 101     (with-output-to-string (s) (print-separated-strings s "|" '("ab" "cd") nil))
 102     "ab|cd")
 103
 104 (deftest :pss.4
 105     (with-output-to-string (s)
 106       (print-separated-strings s "|" '("ab" "cd") nil nil))
 107     "ab|cd")
 108
 109 (deftest :pss.5
 110     (with-output-to-string (s)
 111       (print-separated-strings s "|" '("ab" "cd") nil '("ef") nil))
 112     "ab|cd|ef")
 113
 114 (deftest :css.0 (concat-separated-strings "|" nil) "")
 115 (deftest :css.1 (concat-separated-strings "|" nil nil) "")
 116 (deftest :css.2 (concat-separated-strings "|" '("ab")) "ab")
 117 (deftest :css.3 (concat-separated-strings "|" '("ab" "cd")) "ab|cd")
 118 (deftest :css.4 (concat-separated-strings "|" '("ab" "cd") nil) "ab|cd")
 119 (deftest :css.5 (concat-separated-strings "|" '("ab" "cd") nil '("ef")) "ab|cd|ef")
 120
 121 (deftest :f.1 (map-and-remove-nils #'(lambda (x) (when (oddp x) (* x x)))
 122                      '(0 1 2 3 4 5 6 7 8 9)) (1 9 25 49 81))
 123 (deftest :f.2 (filter #'(lambda (x) (when (oddp x) (* x x)))
 124                      '(0 1 2 3 4 5 6 7 8 9)) (1 3 5 7 9))
 125 (deftest :an.1 (appendnew '(a b c d) '(c c e f)) (a b c d e f))
 126
 127
 128 (deftest :pxml.1
 129   (xml-tag-contents "tag1" "<tag>Test</tag>")
 130   nil nil nil)
 131
 132 (deftest :pxml.2
 133   (xml-tag-contents "tag" "<tag>Test</tag>")
 134   "Test" 15 nil)
 135
 136 (deftest :pxml.3
 137   (xml-tag-contents "tag" "<tag  >Test</tag>")
 138   "Test" 17 nil)
 139
 140 (deftest :pxml.4
 141     (xml-tag-contents "tag" "<tag a=\"b\"></tag>")
 142   "" 17 ("a=\"b\""))
 143
 144 (deftest :pxml.5
 145     (xml-tag-contents "tag" "<tag a=\"b\" >Test</tag>")
 146   "Test" 22 ("a=\"b\""))
 147
 148 (deftest :pxml.6
 149     (xml-tag-contents "tag" "<tag a=\"b\"  c=\"ab\">Test</tag>")
 150   "Test" 29 ("a=\"b\"" "c=\"ab\""))
 151
 152 (deftest :pxml.7
 153     (xml-tag-contents "tag" "<taga a=\"b\"  c=\"ab\">Test</taga>")
 154   nil nil nil)
 155
 156 (deftest :pxml.8
 157     (xml-tag-contents "tag" "<taga a=\"b\"  c=\"ab\">Test<tag>ab</tag></taga>")
 158   "ab" 37 nil)
 159
 160 (deftest :pxml.9
 161     (xml-tag-contents "tag" "<taga a=\"b\"  c=\"ab\">Test<tag>ab</ag></taga>")
 162   nil nil nil)
 163
 164 (deftest :fss.1 (fast-string-search "" "" 0 0 0) 0)
 165 (deftest :fss.2 (fast-string-search "" "abc" 0 0 2) 0)
 166 (deftest :fss.3 (fast-string-search "abc" "" 3 0 0) nil)
 167 (deftest :fss.4 (fast-string-search "abc" "abcde" 3 0 4) 0)
 168 (deftest :fss.5 (fast-string-search "abc" "012abcde" 3 0 7) 3)
 169 (deftest :fss.6 (fast-string-search "abc" "012abcde" 3 0 7) 3)
 170 (deftest :fss.7 (fast-string-search "abc" "012abcde" 3 3 7) 3)
 171 (deftest :fss.8 (fast-string-search "abc" "012abcde" 3 4 7) nil)
 172 (deftest :fss.9 (fast-string-search "abcde" "012abcde" 5 3 8) 3)
 173 (deftest :fss.9b (cl:search "abcde" "012abcde" :start2 3 :end2 8) 3)
 174 (deftest :fss.10 (fast-string-search "abcde" "012abcde" 5 3 7) nil)
 175 (deftest :fss.10b (cl:search "abcde" "012abcde" :start2 3 :end2 7) nil)
 176
 177 (deftest :stlsd.1 (string-to-list-skip-delimiter "") ())
 178 (deftest :stlsd.2 (string-to-list-skip-delimiter "abc") ("abc"))
 179 (deftest :stlsd.3 (string-to-list-skip-delimiter "ab c") ("ab" "c"))
 180 (deftest :stlsd.4 (string-to-list-skip-delimiter "ab  c") ("ab" "c"))
 181 (deftest :stlsd.5 (string-to-list-skip-delimiter "ab   c") ("ab" "c"))
 182 (deftest :stlsd.6 (string-to-list-skip-delimiter "ab   c ") ("ab" "c"))
 183 (deftest :stlsd.7 (string-to-list-skip-delimiter "  ab   c  ") ("ab" "c"))
 184 (deftest :stlsd.8 (string-to-list-skip-delimiter "ab,,c" #\,) ("ab" "c"))
 185 (deftest :stlsd.9 (string-to-list-skip-delimiter "ab,,c,," #\,) ("ab" "c"))
 186 (deftest :stlsd.10 (string-to-list-skip-delimiter " ab") ("ab"))
 187
 188 (deftest :csc.1 (count-string-char "" #\a) 0)
 189 (deftest :csc.2 (count-string-char "abc" #\d) 0)
 190 (deftest :csc.3 (count-string-char "abc" #\b) 1)
 191 (deftest :csc.4 (count-string-char "abcb" #\b) 2)
 192
 193 (deftest :duqs.1 (decode-uri-query-string "") "")
 194 (deftest :duqs.2 (decode-uri-query-string "abc") "abc")
 195 (deftest :duqs.3 (decode-uri-query-string "abc+") "abc ")
 196 (deftest :duqs.4 (decode-uri-query-string "abc+d") "abc d")
 197 (deftest :duqs.5 (decode-uri-query-string "abc%20d") "abc d")
 198
 199 (deftest :sse.1 (string-strip-ending "" nil) "")
 200 (deftest :sse.2 (string-strip-ending "abc" nil) "abc")
 201 (deftest :sse.3 (string-strip-ending "abc" "ab") "abc")
 202 (deftest :sse.4 (string-strip-ending "abc" '("ab")) "abc")
 203 (deftest :sse.5 (string-strip-ending "abcd" '("a" "cd")) "ab")
 204
 205
 206 (defun test-color-conversion ()
 207   (dotimes (ih 11)
 208     (dotimes (is 11)
 209       (dotimes (iv 11)
 210         (let ((h (* ih 30))
 211               (s (/ is 10))
 212               (v (/ iv 10)))
 213           (multiple-value-bind (r g b) (hsv->rgb h s v)
 214             (multiple-value-bind (h2 s2 v2) (rgb->hsv r g b)
 215               (unless (hsv-equal h s v h2 s2 v2)
 216                 (warn "Colors not equal: ~4D ~4D ~4D | ~6D:~6D ~6D:~6D ~6D:~6D~%"
 217                         (float r) (float g) (float b)
 218                         (when (typep h 'number) (float h))
 219                         (when (typep h2 'number) (float h2))
 220                         (float s) (float s2) (float v) (float v2))
 221                 (return-from test-color-conversion nil))))))))
 222   t)
 223
 224 (defun test-color-conversion-float-255 ()
 225   (dotimes (ih 11)
 226     (dotimes (is 11)
 227       (dotimes (iv 11)
 228         (let ((h (* ih 30))
 229               (s (/ is 10))
 230               (v (/ iv 10)))
 231           (multiple-value-bind (r g b) (hsv->rgb h s v)
 232             (setf r (round (* 255 r))
 233                   g (round (* 255 g))
 234                   b (round (* 255 b)))
 235             (multiple-value-bind (h2 s2 v2) (rgb255->hsv255 r g b)
 236               (unless (hsv-similar h s v h2 (/ s2 255) (/ v2 255)
 237                                    :hue-range 10 :saturation-range .1
 238                                    :value-range 1 :black-limit 0 :gray-limit 0)
 239                 (warn "Colors not equal: ~4D ~4D ~4D | ~6D:~6D ~6D:~6D ~6D:~6D~%"
 240                       r g b
 241                       (when (typep h 'number) (float h))
 242                       (when (typep h2 'number) (float h2))
 243                       (float s) (float (/ s2 255)) (float v) (float (/ v2 255)))
 244                 (return-from test-color-conversion-float-255 nil))))))))
 245   t)
 246
 247 (defun test-color-conversion-255-float ()
 248   (dotimes (ih 11)
 249     (dotimes (is 11)
 250       (dotimes (iv 11)
 251         (let ((h (* ih 30))
 252               (s (/ is 10))
 253               (v (/ iv 10)))
 254           (multiple-value-bind (r g b) (hsv255->rgb255 h (truncate (* 255 s))
 255                                                        (truncate (* 255 v)))
 256             (setf r (/ r 255)
 257                   g (/ g 255)
 258                   b (/ b 255))
 259
 260             (multiple-value-bind (h2 s2 v2) (rgb->hsv r g b)
 261               (unless (hsv-similar h s v h2 s2 v2
 262                                    :hue-range 10 :saturation-range .1
 263                                    :value-range 1 :black-limit 0 :gray-limit 0)
 264                 (warn "Colors not equal: ~4D ~4D ~4D | ~6D:~6D ~6D:~6D ~6D:~6D~%"
 265                       r g b
 266                       (when (typep h 'number) (float h))
 267                       (when (typep h2 'number) (float h2))
 268                       (float s) (float (/ s2 255)) (float v) (float (/ v2 255)))
 269                 (return-from test-color-conversion-255-float nil))))))))
 270   t)
 271
 272 (defun test-color-conversion-255 ()
 273   (dotimes (ih 11)
 274     (dotimes (is 11)
 275       (dotimes (iv 11)
 276         (let ((h (* ih 30))
 277               (s (truncate (* 255 (/ is 10))))
 278               (v (truncate (* 255 (/ iv 10)))))
 279           (multiple-value-bind (r g b) (hsv255->rgb255 h s v)
 280             (multiple-value-bind (h2 s2 v2) (rgb255->hsv255 r g b)
 281               (unless (hsv255-similar h s v h2 s2 v2 :hue-range 10 :saturation-range 5
 282                                       :value-range 5 :black-limit 0 :gray-limit 0)
 283                 (warn "Colors not equal: ~D ~D ~D |~
 284  ~3,'0D:~3,'0D ~3,'0D:~3,'0D ~3,'0D:~3,'0D~%"
 285                       r g b
 286                       h h2 s s2 v v2)
 287                 (return-from test-color-conversion-255 nil))))))))
 288   t)
 289
 290 (deftest :color.conv (test-color-conversion) t)
 291 (deftest :color.conv.float.255 (test-color-conversion-float-255) t)
 292 (deftest :color.conv.255.float (test-color-conversion-255-float) t)
 293 (deftest :color.conv.255 (test-color-conversion-255) t)
 294
 295 (deftest :hue.diff.1 (hue-difference 10 10) 0)
 296 (deftest :hue.diff.2 (hue-difference 10 9) -1)
 297 (deftest :hue.diff.3 (hue-difference 9 10) 1)
 298 (deftest :hue.diff.4 (hue-difference 10 nil) 360)
 299 (deftest :hue.diff.5 (hue-difference nil 1) 360)
 300 (deftest :hue.diff.7 (hue-difference 10 190) 180)
 301 (deftest :hue.diff.8 (hue-difference 190 10) -180)
 302 (deftest :hue.diff.9 (hue-difference 1 359) -2)
 303 (deftest :hue.diff.10 (hue-difference 1 182) -179)
 304 (deftest :hue.diff.11 (hue-difference 1 270) -91)
 305
 306 (deftest :hsv.sim.1 (hsv-similar 100 .5 .5 110 .5 .5 :hue-range 5
 307                                 :value-range 0 :saturation-range 0
 308                                 :black-limit 0 :gray-limit 0) nil)
 309 (deftest :hsv.sim.2 (hsv-similar 100 .5 .5 110 .5 .5 :hue-range 15
 310                                 :value-range 0 :saturation-range 0
 311                                 :black-limit 0 :gray-limit 0) t)
 312 (deftest :hsv.sim.3 (hsv-similar 100 .5 .5 110 .5 .6 :hue-range 15
 313                                 :value-range .2 :saturation-range 0
 314                                 :black-limit 0 :gray-limit 0) t)
 315 (deftest :hsv.sim.4 (hsv-similar 100 .5 .5 110 .5 .8 :hue-range 15
 316                                 :value-range 0.2 :saturation-range 0
 317                                 :black-limit 0 :gray-limit 0) nil)
 318 (deftest :hsv.sim.5 (hsv-similar 100 .5 .5 110 .6 .6 :hue-range 15
 319                                 :value-range 0.2 :saturation-range .2
 320                                 :black-limit 0 :gray-limit 0) t)
 321 (deftest :hsv.sim.6 (hsv-similar 100 .5 .5 110 .6 .8 :hue-range 15
 322                                 :value-range 0.2 :saturation-range .2
 323                                 :black-limit 0 :gray-limit 0) nil)
 324 (deftest :hsv.sim.7 (hsv-similar 100 .5 .05 110 .6 .01 :hue-range 0
 325                                 :value-range 0 :saturation-range 0
 326                                 :black-limit .1 :gray-limit 0) t)
 327 (deftest :hsv.sim.8 (hsv-similar 100 .01 .5 110 .09 .6 :hue-range 0
 328                                 :value-range 0.2 :saturation-range 0
 329                                 :black-limit 0 :gray-limit .1) t)
 330 (deftest :hsv.sim.9 (hsv-similar 100 .01 .5 110 .09 .6 :hue-range 0
 331                                 :value-range 0.05 :saturation-range 0
 332                                 :black-limit 0 :gray-limit .1) nil)
 333
 334 #+ignore
 335 (progn
 336 (deftest :dst.1
 337     (is-dst-change-usa-spring-utime
 338      (encode-universal-time 0 0 0 2 4 2000)) t)
 339 (deftest :dst.2
 340     (is-dst-change-usa-spring-utime
 341      (encode-universal-time 0 0 0 1 4 2000)) nil)
 342 (deftest :dst.3
 343     (is-dst-change-usa-spring-utime
 344      (encode-universal-time 0 0 0 3 4 2000)) nil)
 345 (deftest :dst.4
 346     (is-dst-change-usa-fall-utime
 347      (encode-universal-time 0 0 0 31 10 2004)) t)
 348 (deftest :dst.5
 349     (is-dst-change-usa-fall-utime
 350      (encode-universal-time 0 0 0 30 10 2004)) nil)
 351 (deftest :dst.6
 352     (is-dst-change-usa-fall-utime
 353      (encode-universal-time 0 0 0 1 11 2000)) nil)
 354 )
 355
 356
 357 (deftest :ekdc.1
 358     (ensure-keyword-default-case (read-from-string "TYPE")) :type)
 359
 360 (deftest :ekdc.2
 361     (ensure-keyword-default-case (read-from-string "type")) :type)
 362
 363
 364 (deftest :se.1
 365     (string-elide "A Test string" 10 :end) "A Test ..." )
 366
 367 (deftest :se.2
 368     (string-elide "A Test string" 13 :end) "A Test string")
 369
 370 (deftest :se.3
 371     (string-elide "A Test string" 11 :end) "A Test s..." )
 372
 373 (deftest :se.4
 374     (string-elide "A Test string" 2 :middle) "...")
 375
 376 (deftest :se.5
 377     (string-elide "A Test string" 11 :middle) "A Te...ring")
 378
 379 (deftest :se.6
 380     (string-elide "A Test string" 12 :middle) "A Tes...ring")
 381
 382 (deftest :url.1
 383     (make-url "pg")
 384   "pg")
 385
 386 (deftest :url.2
 387     (make-url "pg" :anchor "now")
 388   "pg#now")
 389
 390 (deftest :url.3
 391     (make-url "pg" :vars '(("a" . "5")))
 392   "pg?a=5")
 393
 394 (deftest :url.4
 395     (make-url "pg" :anchor "then" :vars '(("a" . "5") ("b" . "pi")))
 396   "pg?a=5&b=pi#then")
 397
 398 (defclass test-unique ()
 399   ((a :initarg :a)
 400    (b :initarg :b)))
 401
 402
 403 (deftest :unique.1
 404     (let ((list (list (make-instance 'test-unique :a 1 :b 1)
 405                       (make-instance 'test-unique :a 2 :b 2)
 406                       (make-instance 'test-unique :a 3 :b 2))))
 407       (values
 408        (unique-slot-values list 'a)
 409        (unique-slot-values list 'b)))
 410   (1 2 3) (1 2))
 411
 412 (deftest :unique.2
 413     (unique-slot-values nil 'a)
 414   nil)
 415
 416 (deftest :nwp.1
 417        (numbers-within-percentage 1. 1.1 9)
 418   nil)
 419
 420 (deftest :nwp.2
 421        (numbers-within-percentage 1. 1.1 11)
 422   t)
 423
 424 (deftest :pfs.1 (prefixed-fixnum-string 0 #\A 5) "A00000")
 425
 426 (deftest :pfs.2 (prefixed-fixnum-string 1 #\A 5) "A00001")
 427
 428 (deftest :pfs.3 (prefixed-fixnum-string 21 #\B 3) "B021")
 429
 430 (deftest :pis.4 (prefixed-integer-string 234134 #\C 7) "C0234134")
 431
 432  ;;; MOP Testing
 433
 434 ;; Disable attrib class until understand changes in sbcl/cmucl
 435 ;; using COMPUTE-SLOT-ACCESSOR-INFO and defining method
 436 ;; for slot access of ALL-ATTRIBUTES. Does this work on Allegro/LW?
 437
 438 #+ignore
 439 (progn
 440 (eval-when (:compile-toplevel :load-toplevel :execute)
 441   (when (find-package '#:kmr-mop)
 442     (pushnew :kmrtest-mop cl:*features*)))
 443
 444 #+kmrtest-mop
 445 (setf (find-class 'monitored-credit-rating) nil)
 446 #+kmrtest-mop
 447 (setf (find-class 'credit-rating) nil)
 448
 449 #+kmrtest-mop
 450 (defclass credit-rating ()
 451   ((level :attributes (date-set time-set))
 452    (id :attributes (person-setting)))
 453   #+lispworks (:optimize-slot-access nil)
 454   (:metaclass attributes-class))
 455
 456
 457 #+kmrtest-mop
 458 (defclass monitored-credit-rating ()
 459   ((level :attributes (last-checked interval date-set))
 460    (cc :initarg :cc)
 461    (id :attributes (verified)))
 462   (:metaclass attributes-class))
 463
 464 #+kmrtest-mop
 465 (deftest :attrib.mop.1
 466          (let ((cr (make-instance 'credit-rating)))
 467            (slot-attribute cr 'level 'date-set))
 468          nil)
 469
 470 #+kmrtest-mop
 471 (deftest :attrib.mop.2
 472          (let ((cr (make-instance 'credit-rating)))
 473            (setf (slot-attribute cr 'level 'date-set) "12/15/1990")
 474            (let ((result (slot-attribute cr 'level 'date-set)))
 475              (setf (slot-attribute cr 'level 'date-set) nil)
 476              result))
 477          "12/15/1990")
 478
 479 #+kmrtest-mop
 480 (deftest :attrib.mop.3
 481          (let ((mcr (make-instance 'monitored-credit-rating)))
 482            (setf (slot-attribute mcr 'level 'date-set) "01/05/2002")
 483            (let ((result (slot-attribute mcr 'level 'date-set)))
 484              (setf (slot-attribute mcr 'level 'date-set) nil)
 485              result))
 486          "01/05/2002")
 487
 488
 489 #+kmrtest-mop
 490 (eval-when (:compile-toplevel :load-toplevel :execute)
 491   (setq cl:*features* (delete :kmrtest-mop cl:*features*)))
 492
 493 ) ;; progn