Menu
▾
▴
clisp-cvs digest, Vol 1 #1077 - 3 msgs
|
From: <cli...@li...> - 2005-05-04 03:13:01
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/tests tests.lisp,1.57,1.58 ChangeLog,1.348,1.349 (Sam Steingold) 2. clisp/src eval.d,1.197,1.198 ChangeLog,1.4530,1.4531 (Sam Steingold) 3. clisp/src compiler.lisp,1.272,1.273 ChangeLog,1.4531,1.4532 (Sam Steingold) --__--__-- Message: 1 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/tests tests.lisp,1.57,1.58 ChangeLog,1.348,1.349 Date: Tue, 03 May 2005 17:40:37 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/tests In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv981/tests Modified Files: tests.lisp ChangeLog Log Message: (pretty-compare): new generic function the SEQUENCE method extracted from DO-TEST the new PATHNAME method implemented (do-test): use it Index: tests.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/tests/tests.lisp,v retrieving revision 1.57 retrieving revision 1.58 diff -u -d -r1.57 -r1.58 --- tests.lisp 18 Apr 2005 19:55:07 -0000 1.57 +++ tests.lisp 3 May 2005 17:40:33 -0000 1.58 @@ -69,6 +69,31 @@ (error "eval: ~S; compile: ~S" e-value c-value)) e-value)))) +(defgeneric pretty-compare (result my-result log) + (:documentation "print a pretty comparison of two results") + (:method ((result sequence) (my-result sequence) (log stream)) + (let ((pos (mismatch result my-result :test #'equalp))) + (let ((*print-length* 10)) + (flet ((pretty-tail-10 (seq) + (if (and (> (length seq) (+ pos 10)) + (typep seq 'string)) + (concatenate 'string (subseq seq pos (+ pos 10)) "...") + (subseq seq pos)))) + (format log "~&Differ at position ~:D: ~S vs ~S~%CORRECT: ~S~%~7A: ~S~%" + pos + (if (< pos (length result)) (elt result pos) 'end-of-sequence) + (if (< pos (length my-result)) (elt my-result pos) 'end-of-sequence) + (pretty-tail-10 result) + lisp-implementation + (pretty-tail-10 my-result)))))) + (:method ((result pathname) (my-result pathname) (log stream)) + (dolist (slot '(pathname-host pathname-device pathname-directory + pathname-name pathname-type pathname-version)) + (let ((s-r (funcall slot result)) (s-m (funcall slot my-result))) + (format log "~&~S:~%CORRECT: ~S~%~7A: ~S~%~:[ DIFFERENT!~;same~]~%" + slot s-r lisp-implementation s-m (equal s-r s-m))))) + (:method ((result t) (my-result t) (log stream)))) ; do nothing + (defvar *test-ignore-errors* t) (defun do-test (stream log) (let ((eof "EOF") (error-count 0) (total-count 0)) @@ -94,22 +119,7 @@ (format log "~&Form: ~S~%CORRECT: ~S~%~7A: ~S~%~@[~A~%~]" form result lisp-implementation my-result error-message) - (when (and (typep result 'sequence) - (typep my-result 'sequence)) - (let ((pos (mismatch result my-result :test #'equalp))) - (let ((*print-length* 10)) - (flet ((pretty-tail-10 (seq) - (if (and (> (length seq) (+ pos 10)) - (typep seq 'string)) - (concatenate 'string (subseq seq pos (+ pos 10)) "...") - (subseq seq pos)))) - (format log "~&Differ at position ~:D: ~S vs ~S~%CORRECT: ~S~%~7A: ~S~%" - pos - (if (< pos (length result)) (elt result pos) 'end-of-sequence) - (if (< pos (length my-result)) (elt my-result pos) 'end-of-sequence) - (pretty-tail-10 result) - lisp-implementation - (pretty-tail-10 my-result)))))) + (pretty-compare result my-result log) (format log "~%")))))) (values total-count error-count))) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v retrieving revision 1.348 retrieving revision 1.349 diff -u -d -r1.348 -r1.349 --- ChangeLog 2 May 2005 20:45:26 -0000 1.348 +++ ChangeLog 3 May 2005 17:40:34 -0000 1.349 @@ -1,3 +1,10 @@ +2005-05-03 Sam Steingold <sd...@gn...> + + * tests.lisp (pretty-compare): new generic function + the SEQUENCE method extracted from DO-TEST + the new PATHNAME method implemented + (do-test): use it + 2005-05-02 Sam Steingold <sd...@gn...> * pack11.tst: check that REQUIRE accepts a CHARACTER --__--__-- Message: 2 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src eval.d,1.197,1.198 ChangeLog,1.4530,1.4531 Date: Tue, 03 May 2005 17:42:30 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1211/src Modified Files: eval.d ChangeLog Log Message: (funcall): pass args_on_stack to with_saved_back_trace_subr Index: eval.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/eval.d,v retrieving revision 1.197 retrieving revision 1.198 diff -u -d -r1.197 -r1.198 --- eval.d 24 Apr 2005 22:44:30 -0000 1.197 +++ eval.d 3 May 2005 17:41:34 -0000 1.198 @@ -5335,7 +5335,7 @@ (*(subr_rest_function_t*)(TheSubr(fun)->function))(argcount,rest_args_pointer); ); goto done; apply_subr_norest: - with_saved_back_trace_subr(fun,STACK,-1, + with_saved_back_trace_subr(fun,STACK,args_on_stack, (*(subr_norest_function_t*)(TheSubr(fun)->function))(); ); done: #if STACKCHECKS Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.4530 retrieving revision 1.4531 diff -u -d -r1.4530 -r1.4531 --- ChangeLog 2 May 2005 20:45:39 -0000 1.4530 +++ ChangeLog 3 May 2005 17:41:54 -0000 1.4531 @@ -1,3 +1,7 @@ +2005-05-03 Sam Steingold <sd...@gn...> + + * eval.d (funcall): pass args_on_stack to with_saved_back_trace_subr + 2005-05-02 Sam Steingold <sd...@gn...> * compiler.lisp (c-PROVIDE, c-REQUIRE): --__--__-- Message: 3 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src compiler.lisp,1.272,1.273 ChangeLog,1.4531,1.4532 Date: Tue, 03 May 2005 17:49:16 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2759/src Modified Files: compiler.lisp ChangeLog Log Message: (compile-file-pathname-helper): use read-time instead of run-time to produce a constant pathname Index: compiler.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/compiler.lisp,v retrieving revision 1.272 retrieving revision 1.273 diff -u -d -r1.272 -r1.273 --- compiler.lisp 2 May 2005 20:45:38 -0000 1.272 +++ compiler.lisp 3 May 2005 17:49:01 -0000 1.273 @@ -11044,7 +11044,7 @@ (let ((input-file (or (and (not (logical-pathname-p (pathname file))) (first (search-file file *source-file-types*))) - (merge-pathnames file (make-pathname :type "lisp"))))) + (merge-pathnames file #.(make-pathname :type "lisp"))))) (values (if (or (null output-file) (streamp output-file)) output-file Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.4531 retrieving revision 1.4532 diff -u -d -r1.4531 -r1.4532 --- ChangeLog 3 May 2005 17:41:54 -0000 1.4531 +++ ChangeLog 3 May 2005 17:49:12 -0000 1.4532 @@ -1,5 +1,10 @@ 2005-05-03 Sam Steingold <sd...@gn...> + * compiler.lisp (compile-file-pathname-helper): use read-time + instead of run-time to produce a constant pathname + +2005-05-03 Sam Steingold <sd...@gn...> + * eval.d (funcall): pass args_on_stack to with_saved_back_trace_subr 2005-05-02 Sam Steingold <sd...@gn...> --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |