From: Kevin M. Rosenberg Date: Thu, 17 Jun 2004 20:32:00 +0000 (+0000) Subject: r9652: improve make-url, rename tests X-Git-Tag: v1.96~69 X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=commitdiff_plain;h=6edcb840b821b4be95925fe39ce34ee5e1f229d7 r9652: improve make-url, rename tests --- diff --git a/debian/changelog b/debian/changelog index 16bd137..96d7fad 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-kmrcl (1.74-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Thu, 17 Jun 2004 13:05:02 -0700 + cl-kmrcl (1.73-1) unstable; urgency=low * New upstream diff --git a/symbols.lisp b/symbols.lisp index f4fc111..870426e 100644 --- a/symbols.lisp +++ b/symbols.lisp @@ -53,9 +53,8 @@ (pushnew :kmrcl-case-sensitive *features*))) (defun string-default-case (str) - #+kmrcl-case-sensitive str - #+(and (not kmrcl-case-sensitive) (not kmrcl-lowercase-reader)) (string-upcase str) - #+(and (not kmrcl-case-sensitive) kmrcl-lowercase-reader) (string-downcase str)) + #+(and (not kmrcl-lowercase-reader)) (string-upcase str) + #+(and kmrcl-lowercase-reader) (string-downcase str)) (eval-when (:compile-toplevel :load-toplevel :execute) (setq cl:*features* (delete :kmrcl-lowercase-reader *features*)) diff --git a/tests.lisp b/tests.lisp index 774f013..86e86bd 100644 --- a/tests.lisp +++ b/tests.lisp @@ -21,170 +21,170 @@ (rem-all-tests) -(deftest str.0 (substitute-chars-strings "" nil) "") -(deftest str.1 (substitute-chars-strings "abcd" nil) "abcd") -(deftest str.2 (substitute-chars-strings "abcd" nil) "abcd") -(deftest str.3 (substitute-chars-strings "abcd" '((#\j . "ef"))) "abcd") -(deftest str.4 (substitute-chars-strings "abcd" '((#\a . "ef"))) "efbcd") -(deftest str.5 +(deftest :str.0 (substitute-chars-strings "" nil) "") +(deftest :str.1 (substitute-chars-strings "abcd" nil) "abcd") +(deftest :str.2 (substitute-chars-strings "abcd" nil) "abcd") +(deftest :str.3 (substitute-chars-strings "abcd" '((#\j . "ef"))) "abcd") +(deftest :str.4 (substitute-chars-strings "abcd" '((#\a . "ef"))) "efbcd") +(deftest :str.5 (substitute-chars-strings "abcd" '((#\a . "ef") (#\j . "ghi"))) "efbcd") -(deftest str.6 +(deftest :str.6 (substitute-chars-strings "abcd" '((#\a . "ef") (#\d . "ghi"))) "efbcghi") -(deftest str.7 (escape-xml-string "") "") -(deftest str.8 (escape-xml-string "abcd") "abcd") -(deftest str.9 (escape-xml-string "ab&cd") "ab&cd") -(deftest str.10 (escape-xml-string "ab&cd<") "ab&cd<") -(deftest str.12 (string-trim-last-character "") "") -(deftest str.13 (string-trim-last-character "a") "") -(deftest str.14 (string-trim-last-character "ab") "a") -(deftest str.15 (nstring-trim-last-character "") "") -(deftest str.16 (nstring-trim-last-character "a") "") -(deftest str.17 (nstring-trim-last-character "ab") "a") - -(deftest str.18 (delimited-string-to-list "ab|cd|ef" #\|) +(deftest :str.7 (escape-xml-string "") "") +(deftest :str.8 (escape-xml-string "abcd") "abcd") +(deftest :str.9 (escape-xml-string "ab&cd") "ab&cd") +(deftest :str.10 (escape-xml-string "ab&cd<") "ab&cd<") +(deftest :str.12 (string-trim-last-character "") "") +(deftest :str.13 (string-trim-last-character "a") "") +(deftest :str.14 (string-trim-last-character "ab") "a") +(deftest :str.15 (nstring-trim-last-character "") "") +(deftest :str.16 (nstring-trim-last-character "a") "") +(deftest :str.17 (nstring-trim-last-character "ab") "a") + +(deftest :str.18 (delimited-string-to-list "ab|cd|ef" #\|) ("ab" "cd" "ef")) -(deftest str.19 (delimited-string-to-list "ab|cd|ef" #\| t) +(deftest :str.19 (delimited-string-to-list "ab|cd|ef" #\| t) ("ab" "cd" "ef")) -(deftest str.20 (delimited-string-to-list "") ("")) -(deftest str.21 (delimited-string-to-list "" #\space t) ("")) -(deftest str.22 (delimited-string-to-list "ab") ("ab")) -(deftest str.23 (delimited-string-to-list "ab" #\space t) ("ab")) -(deftest str.24 (delimited-string-to-list "ab|" #\|) ("ab" "")) -(deftest str.25 (delimited-string-to-list "ab|" #\| t) ("ab")) - -(deftest sdstl.1 (string-delimited-string-to-list "ab|cd|ef" "|a") +(deftest :str.20 (delimited-string-to-list "") ("")) +(deftest :str.21 (delimited-string-to-list "" #\space t) ("")) +(deftest :str.22 (delimited-string-to-list "ab") ("ab")) +(deftest :str.23 (delimited-string-to-list "ab" #\space t) ("ab")) +(deftest :str.24 (delimited-string-to-list "ab|" #\|) ("ab" "")) +(deftest :str.25 (delimited-string-to-list "ab|" #\| t) ("ab")) + +(deftest :sdstl.1 (string-delimited-string-to-list "ab|cd|ef" "|a") ("ab|cd|ef")) -(deftest sdstl.2 (string-delimited-string-to-list "ab|cd|ef" "|") +(deftest :sdstl.2 (string-delimited-string-to-list "ab|cd|ef" "|") ("ab" "cd" "ef")) -(deftest sdstl.3 (string-delimited-string-to-list "ab|cd|ef" "cd") +(deftest :sdstl.3 (string-delimited-string-to-list "ab|cd|ef" "cd") ("ab|" "|ef")) -(deftest sdstl.4 (string-delimited-string-to-list "ab|cd|ef" "ab") +(deftest :sdstl.4 (string-delimited-string-to-list "ab|cd|ef" "ab") ("" "|cd|ef")) -(deftest apsl.1 (append-sublists '((a b) (c d))) (a b c d)) -(deftest apsl.2 (append-sublists nil) nil) -(deftest apsl.3 (append-sublists '((a b))) (a b)) -(deftest apsl.4 (append-sublists '((a))) (a)) -(deftest apsl.5 (append-sublists '((a) (b) (c d (e f g)))) (a b c d (e f g))) +(deftest :apsl.1 (append-sublists '((a b) (c d))) (a b c d)) +(deftest :apsl.2 (append-sublists nil) nil) +(deftest :apsl.3 (append-sublists '((a b))) (a b)) +(deftest :apsl.4 (append-sublists '((a))) (a)) +(deftest :apsl.5 (append-sublists '((a) (b) (c d (e f g)))) (a b c d (e f g))) -(deftest pss.0 (with-output-to-string (s) (print-separated-strings s "|" nil)) +(deftest :pss.0 (with-output-to-string (s) (print-separated-strings s "|" nil)) "") -(deftest pss.1 +(deftest :pss.1 (with-output-to-string (s) (print-separated-strings s "|" '("ab")) ) "ab") -(deftest pss.2 +(deftest :pss.2 (with-output-to-string (s) (print-separated-strings s "|" '("ab" "cd"))) "ab|cd") -(deftest pss.3 +(deftest :pss.3 (with-output-to-string (s) (print-separated-strings s "|" '("ab" "cd") nil)) "ab|cd") -(deftest pss.4 +(deftest :pss.4 (with-output-to-string (s) (print-separated-strings s "|" '("ab" "cd") nil nil)) "ab|cd") -(deftest pss.5 +(deftest :pss.5 (with-output-to-string (s) (print-separated-strings s "|" '("ab" "cd") nil '("ef") nil)) "ab|cd|ef") -(deftest css.0 (concat-separated-strings "|" nil) "") -(deftest css.1 (concat-separated-strings "|" nil nil) "") -(deftest css.2 (concat-separated-strings "|" '("ab")) "ab") -(deftest css.3 (concat-separated-strings "|" '("ab" "cd")) "ab|cd") -(deftest css.4 (concat-separated-strings "|" '("ab" "cd") nil) "ab|cd") -(deftest css.5 (concat-separated-strings "|" '("ab" "cd") nil '("ef")) "ab|cd|ef") +(deftest :css.0 (concat-separated-strings "|" nil) "") +(deftest :css.1 (concat-separated-strings "|" nil nil) "") +(deftest :css.2 (concat-separated-strings "|" '("ab")) "ab") +(deftest :css.3 (concat-separated-strings "|" '("ab" "cd")) "ab|cd") +(deftest :css.4 (concat-separated-strings "|" '("ab" "cd") nil) "ab|cd") +(deftest :css.5 (concat-separated-strings "|" '("ab" "cd") nil '("ef")) "ab|cd|ef") -(deftest f.1 (map-and-remove-nils #'(lambda (x) (when (oddp x) (* x x))) +(deftest :f.1 (map-and-remove-nils #'(lambda (x) (when (oddp x) (* x x))) '(0 1 2 3 4 5 6 7 8 9)) (1 9 25 49 81)) -(deftest f.2 (filter #'(lambda (x) (when (oddp x) (* x x))) +(deftest :f.2 (filter #'(lambda (x) (when (oddp x) (* x x))) '(0 1 2 3 4 5 6 7 8 9)) (1 3 5 7 9)) -(deftest an.1 (appendnew '(a b c d) '(c c e f)) (a b c d e f)) +(deftest :an.1 (appendnew '(a b c d) '(c c e f)) (a b c d e f)) -(deftest pxml.1 +(deftest :pxml.1 (xml-tag-contents "tag1" "Test") nil nil nil) -(deftest pxml.2 +(deftest :pxml.2 (xml-tag-contents "tag" "Test") "Test" 15 nil) -(deftest pxml.3 +(deftest :pxml.3 (xml-tag-contents "tag" "Test") "Test" 17 nil) -(deftest pxml.4 +(deftest :pxml.4 (xml-tag-contents "tag" "") "" 17 ("a=\"b\"")) -(deftest pxml.5 +(deftest :pxml.5 (xml-tag-contents "tag" "Test") "Test" 22 ("a=\"b\"")) -(deftest pxml.6 +(deftest :pxml.6 (xml-tag-contents "tag" "Test") "Test" 29 ("a=\"b\"" "c=\"ab\"")) -(deftest pxml.7 +(deftest :pxml.7 (xml-tag-contents "tag" "Test") nil nil nil) -(deftest pxml.8 +(deftest :pxml.8 (xml-tag-contents "tag" "Testab") "ab" 37 nil) -(deftest pxml.9 +(deftest :pxml.9 (xml-tag-contents "tag" "Testab") nil nil nil) -(deftest fss.1 (fast-string-search "" "" 0 0 0) 0) -(deftest fss.2 (fast-string-search "" "abc" 0 0 2) 0) -(deftest fss.3 (fast-string-search "abc" "" 3 0 0) nil) -(deftest fss.4 (fast-string-search "abc" "abcde" 3 0 4) 0) -(deftest fss.5 (fast-string-search "abc" "012abcde" 3 0 7) 3) -(deftest fss.6 (fast-string-search "abc" "012abcde" 3 0 7) 3) -(deftest fss.7 (fast-string-search "abc" "012abcde" 3 3 7) 3) -(deftest fss.8 (fast-string-search "abc" "012abcde" 3 4 7) nil) -(deftest fss.9 (fast-string-search "abcde" "012abcde" 5 3 8) 3) -(deftest fss.9b (cl:search "abcde" "012abcde" :start2 3 :end2 8) 3) -(deftest fss.10 (fast-string-search "abcde" "012abcde" 5 3 7) nil) -(deftest fss.10b (cl:search "abcde" "012abcde" :start2 3 :end2 7) nil) - -(deftest stlsd.1 (string-to-list-skip-delimiter "") ()) -(deftest stlsd.2 (string-to-list-skip-delimiter "abc") ("abc")) -(deftest stlsd.3 (string-to-list-skip-delimiter "ab c") ("ab" "c")) -(deftest stlsd.4 (string-to-list-skip-delimiter "ab c") ("ab" "c")) -(deftest stlsd.5 (string-to-list-skip-delimiter "ab c") ("ab" "c")) -(deftest stlsd.6 (string-to-list-skip-delimiter "ab c ") ("ab" "c")) -(deftest stlsd.7 (string-to-list-skip-delimiter " ab c ") ("ab" "c")) -(deftest stlsd.8 (string-to-list-skip-delimiter "ab,,c" #\,) ("ab" "c")) -(deftest stlsd.9 (string-to-list-skip-delimiter "ab,,c,," #\,) ("ab" "c")) -(deftest stlsd.10 (string-to-list-skip-delimiter " ab") ("ab")) - -(deftest csc.1 (count-string-char "" #\a) 0) -(deftest csc.2 (count-string-char "abc" #\d) 0) -(deftest csc.3 (count-string-char "abc" #\b) 1) -(deftest csc.4 (count-string-char "abcb" #\b) 2) - -(deftest duqs.1 (decode-uri-query-string "") "") -(deftest duqs.2 (decode-uri-query-string "abc") "abc") -(deftest duqs.3 (decode-uri-query-string "abc+") "abc ") -(deftest duqs.4 (decode-uri-query-string "abc+d") "abc d") -(deftest duqs.5 (decode-uri-query-string "abc%20d") "abc d") - -(deftest sse.1 (string-strip-ending "" nil) "") -(deftest sse.2 (string-strip-ending "abc" nil) "abc") -(deftest sse.3 (string-strip-ending "abc" "ab") "abc") -(deftest sse.4 (string-strip-ending "abc" '("ab")) "abc") -(deftest sse.5 (string-strip-ending "abcd" '("a" "cd")) "ab") +(deftest :fss.1 (fast-string-search "" "" 0 0 0) 0) +(deftest :fss.2 (fast-string-search "" "abc" 0 0 2) 0) +(deftest :fss.3 (fast-string-search "abc" "" 3 0 0) nil) +(deftest :fss.4 (fast-string-search "abc" "abcde" 3 0 4) 0) +(deftest :fss.5 (fast-string-search "abc" "012abcde" 3 0 7) 3) +(deftest :fss.6 (fast-string-search "abc" "012abcde" 3 0 7) 3) +(deftest :fss.7 (fast-string-search "abc" "012abcde" 3 3 7) 3) +(deftest :fss.8 (fast-string-search "abc" "012abcde" 3 4 7) nil) +(deftest :fss.9 (fast-string-search "abcde" "012abcde" 5 3 8) 3) +(deftest :fss.9b (cl:search "abcde" "012abcde" :start2 3 :end2 8) 3) +(deftest :fss.10 (fast-string-search "abcde" "012abcde" 5 3 7) nil) +(deftest :fss.10b (cl:search "abcde" "012abcde" :start2 3 :end2 7) nil) + +(deftest :stlsd.1 (string-to-list-skip-delimiter "") ()) +(deftest :stlsd.2 (string-to-list-skip-delimiter "abc") ("abc")) +(deftest :stlsd.3 (string-to-list-skip-delimiter "ab c") ("ab" "c")) +(deftest :stlsd.4 (string-to-list-skip-delimiter "ab c") ("ab" "c")) +(deftest :stlsd.5 (string-to-list-skip-delimiter "ab c") ("ab" "c")) +(deftest :stlsd.6 (string-to-list-skip-delimiter "ab c ") ("ab" "c")) +(deftest :stlsd.7 (string-to-list-skip-delimiter " ab c ") ("ab" "c")) +(deftest :stlsd.8 (string-to-list-skip-delimiter "ab,,c" #\,) ("ab" "c")) +(deftest :stlsd.9 (string-to-list-skip-delimiter "ab,,c,," #\,) ("ab" "c")) +(deftest :stlsd.10 (string-to-list-skip-delimiter " ab") ("ab")) + +(deftest :csc.1 (count-string-char "" #\a) 0) +(deftest :csc.2 (count-string-char "abc" #\d) 0) +(deftest :csc.3 (count-string-char "abc" #\b) 1) +(deftest :csc.4 (count-string-char "abcb" #\b) 2) + +(deftest :duqs.1 (decode-uri-query-string "") "") +(deftest :duqs.2 (decode-uri-query-string "abc") "abc") +(deftest :duqs.3 (decode-uri-query-string "abc+") "abc ") +(deftest :duqs.4 (decode-uri-query-string "abc+d") "abc d") +(deftest :duqs.5 (decode-uri-query-string "abc%20d") "abc d") + +(deftest :sse.1 (string-strip-ending "" nil) "") +(deftest :sse.2 (string-strip-ending "abc" nil) "abc") +(deftest :sse.3 (string-strip-ending "abc" "ab") "abc") +(deftest :sse.4 (string-strip-ending "abc" '("ab")) "abc") +(deftest :sse.5 (string-strip-ending "abcd" '("a" "cd")) "ab") (defun test-color-conversion () @@ -271,98 +271,114 @@ (return-from test-color-conversion-255 nil)))))))) t) -(deftest color.conv (test-color-conversion) t) -(deftest color.conv.float.255 (test-color-conversion-float-255) t) -(deftest color.conv.255.float (test-color-conversion-255-float) t) -(deftest color.conv.255 (test-color-conversion-255) t) - -(deftest hue.diff.1 (hue-difference 10 10) 0) -(deftest hue.diff.2 (hue-difference 10 9) -1) -(deftest hue.diff.3 (hue-difference 9 10) 1) -(deftest hue.diff.4 (hue-difference 10 nil) 360) -(deftest hue.diff.5 (hue-difference nil 1) 360) -(deftest hue.diff.7 (hue-difference 10 190) 180) -(deftest hue.diff.8 (hue-difference 190 10) -180) -(deftest hue.diff.9 (hue-difference 1 359) -2) -(deftest hue.diff.10 (hue-difference 1 182) -179) -(deftest hue.diff.11 (hue-difference 1 270) -91) - -(deftest hsv.sim.1 (hsv-similar 100 .5 .5 110 .5 .5 :hue-range 5 +(deftest :color.conv (test-color-conversion) t) +(deftest :color.conv.float.255 (test-color-conversion-float-255) t) +(deftest :color.conv.255.float (test-color-conversion-255-float) t) +(deftest :color.conv.255 (test-color-conversion-255) t) + +(deftest :hue.diff.1 (hue-difference 10 10) 0) +(deftest :hue.diff.2 (hue-difference 10 9) -1) +(deftest :hue.diff.3 (hue-difference 9 10) 1) +(deftest :hue.diff.4 (hue-difference 10 nil) 360) +(deftest :hue.diff.5 (hue-difference nil 1) 360) +(deftest :hue.diff.7 (hue-difference 10 190) 180) +(deftest :hue.diff.8 (hue-difference 190 10) -180) +(deftest :hue.diff.9 (hue-difference 1 359) -2) +(deftest :hue.diff.10 (hue-difference 1 182) -179) +(deftest :hue.diff.11 (hue-difference 1 270) -91) + +(deftest :hsv.sim.1 (hsv-similar 100 .5 .5 110 .5 .5 :hue-range 5 :value-range 0 :saturation-range 0 :black-limit 0 :gray-limit 0) nil) -(deftest hsv.sim.2 (hsv-similar 100 .5 .5 110 .5 .5 :hue-range 15 +(deftest :hsv.sim.2 (hsv-similar 100 .5 .5 110 .5 .5 :hue-range 15 :value-range 0 :saturation-range 0 :black-limit 0 :gray-limit 0) t) -(deftest hsv.sim.3 (hsv-similar 100 .5 .5 110 .5 .6 :hue-range 15 +(deftest :hsv.sim.3 (hsv-similar 100 .5 .5 110 .5 .6 :hue-range 15 :value-range .2 :saturation-range 0 :black-limit 0 :gray-limit 0) t) -(deftest hsv.sim.4 (hsv-similar 100 .5 .5 110 .5 .8 :hue-range 15 +(deftest :hsv.sim.4 (hsv-similar 100 .5 .5 110 .5 .8 :hue-range 15 :value-range 0.2 :saturation-range 0 :black-limit 0 :gray-limit 0) nil) -(deftest hsv.sim.5 (hsv-similar 100 .5 .5 110 .6 .6 :hue-range 15 +(deftest :hsv.sim.5 (hsv-similar 100 .5 .5 110 .6 .6 :hue-range 15 :value-range 0.2 :saturation-range .2 :black-limit 0 :gray-limit 0) t) -(deftest hsv.sim.6 (hsv-similar 100 .5 .5 110 .6 .8 :hue-range 15 +(deftest :hsv.sim.6 (hsv-similar 100 .5 .5 110 .6 .8 :hue-range 15 :value-range 0.2 :saturation-range .2 :black-limit 0 :gray-limit 0) nil) -(deftest hsv.sim.7 (hsv-similar 100 .5 .05 110 .6 .01 :hue-range 0 +(deftest :hsv.sim.7 (hsv-similar 100 .5 .05 110 .6 .01 :hue-range 0 :value-range 0 :saturation-range 0 :black-limit .1 :gray-limit 0) t) -(deftest hsv.sim.8 (hsv-similar 100 .01 .5 110 .09 .6 :hue-range 0 +(deftest :hsv.sim.8 (hsv-similar 100 .01 .5 110 .09 .6 :hue-range 0 :value-range 0.2 :saturation-range 0 :black-limit 0 :gray-limit .1) t) -(deftest hsv.sim.9 (hsv-similar 100 .01 .5 110 .09 .6 :hue-range 0 +(deftest :hsv.sim.9 (hsv-similar 100 .01 .5 110 .09 .6 :hue-range 0 :value-range 0.05 :saturation-range 0 :black-limit 0 :gray-limit .1) nil) #+ignore (progn -(deftest dst.1 +(deftest :dst.1 (is-dst-change-usa-spring-utime (encode-universal-time 0 0 0 2 4 2000)) t) -(deftest dst.2 +(deftest :dst.2 (is-dst-change-usa-spring-utime (encode-universal-time 0 0 0 1 4 2000)) nil) -(deftest dst.3 +(deftest :dst.3 (is-dst-change-usa-spring-utime (encode-universal-time 0 0 0 3 4 2000)) nil) -(deftest dst.4 +(deftest :dst.4 (is-dst-change-usa-fall-utime (encode-universal-time 0 0 0 31 10 2004)) t) -(deftest dst.5 +(deftest :dst.5 (is-dst-change-usa-fall-utime (encode-universal-time 0 0 0 30 10 2004)) nil) -(deftest dst.6 +(deftest :dst.6 (is-dst-change-usa-fall-utime (encode-universal-time 0 0 0 1 11 2000)) nil) ) -(deftest ekdc.1 +(deftest :ekdc.1 (ensure-keyword-default-case (read-from-string "TYPE")) :type) -(deftest ekdc.2 +(deftest :ekdc.2 (ensure-keyword-default-case (read-from-string "type")) :type) -(deftest se.1 +(deftest :se.1 (string-elide "A Test string" 10 :end) "A Test ..." ) -(deftest se.2 +(deftest :se.2 (string-elide "A Test string" 13 :end) "A Test string") -(deftest se.3 +(deftest :se.3 (string-elide "A Test string" 11 :end) "A Test s..." ) -(deftest se.4 +(deftest :se.4 (string-elide "A Test string" 2 :middle) "...") -(deftest se.5 +(deftest :se.5 (string-elide "A Test string" 11 :middle) "A Te...ring") -(deftest se.6 +(deftest :se.6 (string-elide "A Test string" 12 :middle) "A Tes...ring") +(deftest :url.1 + (make-url "pg") + "pg") + +(deftest :url.2 + (make-url "pg" :anchor "now") + "pg#now") + +(deftest :url.3 + (make-url "pg" :vars '(("a" . "5"))) + "pg?a=5") + +(deftest :url.4 + (make-url "pg" :anchor "then" :vars '(("a" . "5") ("b" . "pi"))) + "pg?a=5&b=pi#then") + ;;; MOP Testing ;; Disable attrib class until understand changes in sbcl/cmucl @@ -396,13 +412,13 @@ (:metaclass attributes-class)) #+kmrtest-mop -(deftest attrib.mop.1 +(deftest :attrib.mop.1 (let ((cr (make-instance 'credit-rating))) (slot-attribute cr 'level 'date-set)) nil) #+kmrtest-mop -(deftest attrib.mop.2 +(deftest :attrib.mop.2 (let ((cr (make-instance 'credit-rating))) (setf (slot-attribute cr 'level 'date-set) "12/15/1990") (let ((result (slot-attribute cr 'level 'date-set))) @@ -411,7 +427,7 @@ "12/15/1990") #+kmrtest-mop -(deftest attrib.mop.3 +(deftest :attrib.mop.3 (let ((mcr (make-instance 'monitored-credit-rating))) (setf (slot-attribute mcr 'level 'date-set) "01/05/2002") (let ((result (slot-attribute mcr 'level 'date-set))) diff --git a/web-utils.lisp b/web-utils.lisp index cc8f52a..da7d6b7 100644 --- a/web-utils.lisp +++ b/web-utils.lisp @@ -45,7 +45,7 @@ (defun base-url! (url) (setq *base-url* url)) -(defun make-url (page-name &key (base-dir *base-url*) (format :html) (vars nil)) +(defun make-url (page-name &key (base-dir *base-url*) (format :html) vars anchor) (let ((amp (case format (:html "&") @@ -61,8 +61,11 @@ #'(lambda (var) (when (and (car var) (cdr var)) (concatenate 'string - amp (car var) "=" (cdr var)))) + amp (string-downcase (car var)) "=" (cdr var)))) (rest vars)))) + "") + (if anchor + (concatenate 'string "#" anchor) "")))) (defun decode-uri-query-string (s)