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 (deftest :rcs.1 (remove-char-string #\space "") "")
 206 (deftest :rcs.2 (remove-char-string #\space "a") "a")
 207 (deftest :rcs.3 (remove-char-string #\space "ab") "ab")
 208 (deftest :rcs.4 (remove-char-string #\space "a b") "ab")
 209 (deftest :rcs.5 (remove-char-string #\space " a b") "ab")
 210 (deftest :rcs.6 (remove-char-string #\space "a b ") "ab")
 211 (deftest :rcs.7 (remove-char-string #\space "a  b   c  ") "abc")
 212 (deftest :rcs.8 (remove-char-string #\space "a  b   c  d") "abcd")
 213
 214
 215 (defun test-color-conversion ()
 216   (dotimes (ih 11)
 217     (dotimes (is 11)
 218       (dotimes (iv 11)
 219         (let ((h (* ih 30))
 220               (s (/ is 10))
 221               (v (/ iv 10)))
 222           (multiple-value-bind (r g b) (hsv->rgb h s v)
 223             (multiple-value-bind (h2 s2 v2) (rgb->hsv r g b)
 224               (unless (hsv-equal h s v h2 s2 v2)
 225                 (warn "Colors not equal: ~4D ~4D ~4D | ~6D:~6D ~6D:~6D ~6D:~6D~%"
 226                         (float r) (float g) (float b)
 227                         (when (typep h 'number) (float h))
 228                         (when (typep h2 'number) (float h2))
 229                         (float s) (float s2) (float v) (float v2))
 230                 (return-from test-color-conversion nil))))))))
 231   t)
 232
 233 (defun test-color-conversion-float-255 ()
 234   (dotimes (ih 11)
 235     (dotimes (is 11)
 236       (dotimes (iv 11)
 237         (let ((h (* ih 30))
 238               (s (/ is 10))
 239               (v (/ iv 10)))
 240           (multiple-value-bind (r g b) (hsv->rgb h s v)
 241             (setf r (round (* 255 r))
 242                   g (round (* 255 g))
 243                   b (round (* 255 b)))
 244             (multiple-value-bind (h2 s2 v2) (rgb255->hsv255 r g b)
 245               (unless (hsv-similar h s v h2 (/ s2 255) (/ v2 255)
 246                                    :hue-range 10 :saturation-range .1
 247                                    :value-range 1 :black-limit 0 :gray-limit 0)
 248                 (warn "Colors not equal: ~4D ~4D ~4D | ~6D:~6D ~6D:~6D ~6D:~6D~%"
 249                       r g b
 250                       (when (typep h 'number) (float h))
 251                       (when (typep h2 'number) (float h2))
 252                       (float s) (float (/ s2 255)) (float v) (float (/ v2 255)))
 253                 (return-from test-color-conversion-float-255 nil))))))))
 254   t)
 255
 256 (defun test-color-conversion-255-float ()
 257   (dotimes (ih 11)
 258     (dotimes (is 11)
 259       (dotimes (iv 11)
 260         (let ((h (* ih 30))
 261               (s (/ is 10))
 262               (v (/ iv 10)))
 263           (multiple-value-bind (r g b) (hsv255->rgb255 h (truncate (* 255 s))
 264                                                        (truncate (* 255 v)))
 265             (setf r (/ r 255)
 266                   g (/ g 255)
 267                   b (/ b 255))
 268
 269             (multiple-value-bind (h2 s2 v2) (rgb->hsv r g b)
 270               (unless (hsv-similar h s v h2 s2 v2
 271                                    :hue-range 10 :saturation-range .1
 272                                    :value-range 1 :black-limit 0 :gray-limit 0)
 273                 (warn "Colors not equal: ~4D ~4D ~4D | ~6D:~6D ~6D:~6D ~6D:~6D~%"
 274                       r g b
 275                       (when (typep h 'number) (float h))
 276                       (when (typep h2 'number) (float h2))
 277                       (float s) (float (/ s2 255)) (float v) (float (/ v2 255)))
 278                 (return-from test-color-conversion-255-float nil))))))))
 279   t)
 280
 281 (defun test-color-conversion-255 ()
 282   (dotimes (ih 11)
 283     (dotimes (is 11)
 284       (dotimes (iv 11)
 285         (let ((h (* ih 30))
 286               (s (truncate (* 255 (/ is 10))))
 287               (v (truncate (* 255 (/ iv 10)))))
 288           (multiple-value-bind (r g b) (hsv255->rgb255 h s v)
 289             (multiple-value-bind (h2 s2 v2) (rgb255->hsv255 r g b)
 290               (unless (hsv255-similar h s v h2 s2 v2 :hue-range 10 :saturation-range 5
 291                                       :value-range 5 :black-limit 0 :gray-limit 0)
 292                 (warn "Colors not equal: ~D ~D ~D |~
 293  ~3,'0D:~3,'0D ~3,'0D:~3,'0D ~3,'0D:~3,'0D~%"
 294                       r g b
 295                       h h2 s s2 v v2)
 296                 (return-from test-color-conversion-255 nil))))))))
 297   t)
 298
 299 (deftest :color.conv (test-color-conversion) t)
 300 (deftest :color.conv.float.255 (test-color-conversion-float-255) t)
 301 (deftest :color.conv.255.float (test-color-conversion-255-float) t)
 302 (deftest :color.conv.255 (test-color-conversion-255) t)
 303
 304 (deftest :hue.diff.1 (hue-difference 10 10) 0)
 305 (deftest :hue.diff.2 (hue-difference 10 9) -1)
 306 (deftest :hue.diff.3 (hue-difference 9 10) 1)
 307 (deftest :hue.diff.4 (hue-difference 10 nil) 360)
 308 (deftest :hue.diff.5 (hue-difference nil 1) 360)
 309 (deftest :hue.diff.7 (hue-difference 10 190) 180)
 310 (deftest :hue.diff.8 (hue-difference 190 10) -180)
 311 (deftest :hue.diff.9 (hue-difference 1 359) -2)
 312 (deftest :hue.diff.10 (hue-difference 1 182) -179)
 313 (deftest :hue.diff.11 (hue-difference 1 270) -91)
 314
 315 (deftest :hsv.sim.1 (hsv-similar 100 .5 .5 110 .5 .5 :hue-range 5
 316                                 :value-range 0 :saturation-range 0
 317                                 :black-limit 0 :gray-limit 0) nil)
 318 (deftest :hsv.sim.2 (hsv-similar 100 .5 .5 110 .5 .5 :hue-range 15
 319                                 :value-range 0 :saturation-range 0
 320                                 :black-limit 0 :gray-limit 0) t)
 321 (deftest :hsv.sim.3 (hsv-similar 100 .5 .5 110 .5 .6 :hue-range 15
 322                                 :value-range .2 :saturation-range 0
 323                                 :black-limit 0 :gray-limit 0) t)
 324 (deftest :hsv.sim.4 (hsv-similar 100 .5 .5 110 .5 .8 :hue-range 15
 325                                 :value-range 0.2 :saturation-range 0
 326                                 :black-limit 0 :gray-limit 0) nil)
 327 (deftest :hsv.sim.5 (hsv-similar 100 .5 .5 110 .6 .6 :hue-range 15
 328                                 :value-range 0.2 :saturation-range .2
 329                                 :black-limit 0 :gray-limit 0) t)
 330 (deftest :hsv.sim.6 (hsv-similar 100 .5 .5 110 .6 .8 :hue-range 15
 331                                 :value-range 0.2 :saturation-range .2
 332                                 :black-limit 0 :gray-limit 0) nil)
 333 (deftest :hsv.sim.7 (hsv-similar 100 .5 .05 110 .6 .01 :hue-range 0
 334                                 :value-range 0 :saturation-range 0
 335                                 :black-limit .1 :gray-limit 0) t)
 336 (deftest :hsv.sim.8 (hsv-similar 100 .01 .5 110 .09 .6 :hue-range 0
 337                                 :value-range 0.2 :saturation-range 0
 338                                 :black-limit 0 :gray-limit .1) t)
 339 (deftest :hsv.sim.9 (hsv-similar 100 .01 .5 110 .09 .6 :hue-range 0
 340                                 :value-range 0.05 :saturation-range 0
 341                                 :black-limit 0 :gray-limit .1) nil)
 342
 343 #+ignore
 344 (progn
 345 (deftest :dst.1
 346     (is-dst-change-usa-spring-utime
 347      (encode-universal-time 0 0 0 2 4 2000)) t)
 348 (deftest :dst.2
 349     (is-dst-change-usa-spring-utime
 350      (encode-universal-time 0 0 0 1 4 2000)) nil)
 351 (deftest :dst.3
 352     (is-dst-change-usa-spring-utime
 353      (encode-universal-time 0 0 0 3 4 2000)) nil)
 354 (deftest :dst.4
 355     (is-dst-change-usa-fall-utime
 356      (encode-universal-time 0 0 0 31 10 2004)) t)
 357 (deftest :dst.5
 358     (is-dst-change-usa-fall-utime
 359      (encode-universal-time 0 0 0 30 10 2004)) nil)
 360 (deftest :dst.6
 361     (is-dst-change-usa-fall-utime
 362      (encode-universal-time 0 0 0 1 11 2000)) nil)
 363 )
 364
 365
 366 (deftest :ekdc.1
 367     (ensure-keyword-default-case (read-from-string "TYPE")) :type)
 368
 369 (deftest :ekdc.2
 370     (ensure-keyword-default-case (read-from-string "type")) :type)
 371
 372
 373 (deftest :se.1
 374     (string-elide "A Test string" 10 :end) "A Test ..." )
 375
 376 (deftest :se.2
 377     (string-elide "A Test string" 13 :end) "A Test string")
 378
 379 (deftest :se.3
 380     (string-elide "A Test string" 11 :end) "A Test s..." )
 381
 382 (deftest :se.4
 383     (string-elide "A Test string" 2 :middle) "...")
 384
 385 (deftest :se.5
 386     (string-elide "A Test string" 11 :middle) "A Te...ring")
 387
 388 (deftest :se.6
 389     (string-elide "A Test string" 12 :middle) "A Tes...ring")
 390
 391 (deftest :url.1
 392     (make-url "pg")
 393   "pg")
 394
 395 (deftest :url.2
 396     (make-url "pg" :anchor "now")
 397   "pg#now")
 398
 399 (deftest :url.3
 400     (make-url "pg" :vars '(("a" . "5")))
 401   "pg?a=5")
 402
 403 (deftest :url.4
 404     (make-url "pg" :anchor "then" :vars '(("a" . "5") ("b" . "pi")))
 405   "pg?a=5&b=pi#then")
 406
 407 (defclass test-unique ()
 408   ((a :initarg :a)
 409    (b :initarg :b)))
 410
 411
 412 (deftest :unique.1
 413     (let ((list (list (make-instance 'test-unique :a 1 :b 1)
 414                       (make-instance 'test-unique :a 2 :b 2)
 415                       (make-instance 'test-unique :a 3 :b 2))))
 416       (values
 417        (unique-slot-values list 'a)
 418        (unique-slot-values list 'b)))
 419   (1 2 3) (1 2))
 420
 421 (deftest :unique.2
 422     (unique-slot-values nil 'a)
 423   nil)
 424
 425 (deftest :nwp.1
 426        (numbers-within-percentage 1. 1.1 9)
 427   nil)
 428
 429 (deftest :nwp.2
 430        (numbers-within-percentage 1. 1.1 11)
 431   t)
 432
 433 (deftest :pfs.1 (prefixed-fixnum-string 0 #\A 5) "A00000")
 434
 435 (deftest :pfs.2 (prefixed-fixnum-string 1 #\A 5) "A00001")
 436
 437 (deftest :pfs.3 (prefixed-fixnum-string 21 #\B 3) "B021")
 438
 439 (deftest :pis.4 (prefixed-integer-string 234134 #\C 7) "C0234134")
 440
 441  ;;; MOP Testing
 442
 443 ;; Disable attrib class until understand changes in sbcl/cmucl
 444 ;; using COMPUTE-SLOT-ACCESSOR-INFO and defining method
 445 ;; for slot access of ALL-ATTRIBUTES. Does this work on Allegro/LW?
 446
 447 #+ignore
 448 (progn
 449 (eval-when (:compile-toplevel :load-toplevel :execute)
 450   (when (find-package '#:kmr-mop)
 451     (pushnew :kmrtest-mop cl:*features*)))
 452
 453 #+kmrtest-mop
 454 (setf (find-class 'monitored-credit-rating) nil)
 455 #+kmrtest-mop
 456 (setf (find-class 'credit-rating) nil)
 457
 458 #+kmrtest-mop
 459 (defclass credit-rating ()
 460   ((level :attributes (date-set time-set))
 461    (id :attributes (person-setting)))
 462   #+lispworks (:optimize-slot-access nil)
 463   (:metaclass attributes-class))
 464
 465
 466 #+kmrtest-mop
 467 (defclass monitored-credit-rating ()
 468   ((level :attributes (last-checked interval date-set))
 469    (cc :initarg :cc)
 470    (id :attributes (verified)))
 471   (:metaclass attributes-class))
 472
 473 #+kmrtest-mop
 474 (deftest :attrib.mop.1
 475          (let ((cr (make-instance 'credit-rating)))
 476            (slot-attribute cr 'level 'date-set))
 477          nil)
 478
 479 #+kmrtest-mop
 480 (deftest :attrib.mop.2
 481          (let ((cr (make-instance 'credit-rating)))
 482            (setf (slot-attribute cr 'level 'date-set) "12/15/1990")
 483            (let ((result (slot-attribute cr 'level 'date-set)))
 484              (setf (slot-attribute cr 'level 'date-set) nil)
 485              result))
 486          "12/15/1990")
 487
 488 #+kmrtest-mop
 489 (deftest :attrib.mop.3
 490          (let ((mcr (make-instance 'monitored-credit-rating)))
 491            (setf (slot-attribute mcr 'level 'date-set) "01/05/2002")
 492            (let ((result (slot-attribute mcr 'level 'date-set)))
 493              (setf (slot-attribute mcr 'level 'date-set) nil)
 494              result))
 495          "01/05/2002")
 496
 497
 498 #+kmrtest-mop
 499 (eval-when (:compile-toplevel :load-toplevel :execute)
 500   (setq cl:*features* (delete :kmrtest-mop cl:*features*)))
 501
 502 ) ;; progn