Menu
▾
▴
clisp-cvs digest, Vol 1 #645 - 8 msgs
|
From: <cli...@li...> - 2004-08-08 14:49:00
|
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/src makemake.in,1.463,1.464 NEWS,1.162,1.163 ChangeLog,1.3391,1.3392 (Bruno Haible) 2. clisp/src constobj.d,1.136,1.137 (Bruno Haible) 3. clisp/src places.lisp,1.43,1.44 NEWS,1.163,1.164 ChangeLog,1.3392,1.3393 (Bruno Haible) 4. clisp/src package.d,1.83,1.84 defpackage.lisp,1.3,1.4 NEWS,1.164,1.165 ChangeLog,1.3393,1.3394 (Bruno Haible) 5. clisp/src condition.lisp,1.43,1.44 NEWS,1.165,1.166 ChangeLog,1.3394,1.3395 (Bruno Haible) 6. clisp/src io.d,1.239,1.240 NEWS,1.166,1.167 ChangeLog,1.3395,1.3396 (Bruno Haible) 7. clisp/src io.d,1.240,1.241 NEWS,1.167,1.168 ChangeLog,1.3396,1.3397 (Bruno Haible) 8. clisp/src io.d,1.241,1.242 ChangeLog,1.3397,1.3398 (Bruno Haible) --__--__-- Message: 1 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src makemake.in,1.463,1.464 NEWS,1.162,1.163 ChangeLog,1.3391,1.3392 Date: Sun, 08 Aug 2004 14:38:21 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28692/src Modified Files: makemake.in NEWS ChangeLog Log Message: Add sacla-tests to "make check". Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.162 retrieving revision 1.163 diff -u -d -r1.162 -r1.163 --- NEWS 30 Jul 2004 11:59:54 -0000 1.162 +++ NEWS 8 Aug 2004 14:38:17 -0000 1.163 @@ -138,6 +138,10 @@ + DEFSETF lambda-lists now support &ENVIRONMENT. + DEFSETF lambda-lists are no longer destructuring lambda-lists. + NAMESTRING no longer accepts an optional second argument. + Thanks to Paul F. Dietz <di...@dl...> and his ANSI compliance + suite, which helped detect some of these deficiencies. + Thanks to Yuji Minejima <ggb...@ni...> and his ANSI compliance + suite, which helped detect some of these deficiencies. * TRANSLATE-PATHNAME and TRANSLATE-LOGICAL-PATHNAME accept a new keyword argument :ABSOLUTE which makes them convert their return values to Index: makemake.in =================================================================== RCS file: /cvsroot/clisp/clisp/src/makemake.in,v retrieving revision 1.463 retrieving revision 1.464 diff -u -d -r1.463 -r1.464 --- makemake.in 5 Aug 2004 11:15:27 -0000 1.463 +++ makemake.in 8 Aug 2004 14:38:17 -0000 1.464 @@ -499,6 +499,7 @@ RECOMPILEDIR=stage TESTSDIR=tests +SACLATESTSDIR=sacla-tests ANSITESTSDIR=ansi-tests BENCHDIR=benchmarks @@ -2710,7 +2711,7 @@ if [ $CROSS = false ] ; then echol "# Perform self-tests." - echol "check : check-recompile check-tests check-ansi-tests" + echol "check : check-recompile check-tests check-sacla-tests check-ansi-tests" echodummyrule check echol @@ -2812,6 +2813,18 @@ done echol + SACLA_CLISP="../lisp${LEXE} -B .. -M ../lispinit.mem -N ../locale -E UTF-8 -norc -i tests.lisp" + echol "check-sacla-tests : ${SACLATESTSDIR} lisp${LEXE} lispinit.mem" + echotab "cd ${SACLATESTSDIR} && ${SACLA_CLISP} -x '(ext:exit (> (nth-value 1 (run-all-tests)) 0))'" + echol + echol "${SACLATESTSDIR} :" + echotab "-mkdir ${SACLATESTSDIR}" + # on win32, LN_S=copy and it accepts exactly 2 arguments + for f in '*.lisp'; do + echotab "cd ${SACLATESTSDIR} && \$(LN_S) ${PARENT_SRCTOPDIR_}sacla-tests${NEXT_}${f} ." + done + echol + ANSI_CLISP="../lisp${LEXE} -B .. -M ../lispinit.mem -N ../locale -E UTF-8 -m 30000KW -norc -ansi -i clispload.lsp" echol "check-ansi-tests : ${ANSITESTSDIR} lisp${LEXE} lispinit.mem" echotab "cd ${ANSITESTSDIR} && ${ANSI_CLISP} -x '(in-package \"CL-TEST\") (time (regression-test:do-tests)) (ext:exit (regression-test:pending-tests))' 2>&1 | tee ../ansi-tests-log" @@ -3458,7 +3471,7 @@ # without changing the bytecode format and the tables in # constobj.d, constpack.d, constsym.d, subr.d, fsubr.d, pseudofun.d. clean1 : clean0 - -\$(RM) lispbibl.h clisp.h *.i *.s *${TOBJ} *.a lisp${LEXE} clisp-link makevars ${RECOMPILEDIR}${NEXT_}* ${TESTSDIR}${NEXT_}* ${ANSITESTSDIR}${NEXT_}* ansi-tests-log + -\$(RM) lispbibl.h clisp.h *.i *.s *${TOBJ} *.a lisp${LEXE} clisp-link makevars ${RECOMPILEDIR}${NEXT_}* ${TESTSDIR}${NEXT_}* ${SACLATESTSDIR}${NEXT_}* ${ANSITESTSDIR}${NEXT_}* ansi-tests-log -\$(RMRF) base full !! if [ ${LIB_TYPE} = "win32" ] ; then Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3391 retrieving revision 1.3392 diff -u -d -r1.3391 -r1.3392 --- ChangeLog 6 Aug 2004 14:16:59 -0000 1.3391 +++ ChangeLog 8 Aug 2004 14:38:17 -0000 1.3392 @@ -1,3 +1,11 @@ +2004-08-07 Bruno Haible <br...@cl...> + + * sacla-tests: New directory. + * makemake.in (SACLATESTSDIR): New variable. + (check-sacla-tests, ${SACLATESTSDIR}): New targets. + (check): Depend on sacla-tests. + (clean1): Remove also the sacla-tests files. + 2004-08-06 Bruno Haible <br...@cl...> * compiler.lisp (make-trampoline): Make it work with #+CLISP-DEBUG too. --__--__-- Message: 2 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src constobj.d,1.136,1.137 Date: Sun, 08 Aug 2004 14:38:44 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28810/src Modified Files: constobj.d Log Message: Indentation. Index: constobj.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/constobj.d,v retrieving revision 1.136 retrieving revision 1.137 diff -u -d -r1.136 -r1.137 --- constobj.d 5 Aug 2004 11:15:25 -0000 1.136 +++ constobj.d 8 Aug 2004 14:38:41 -0000 1.137 @@ -671,10 +671,10 @@ LISPOBJ(load_extra_file_types,"(\".BAT\")") #endif /* for control & io, function seclass_object(): */ -LISPOBJ(seclass_no_se,"(NIL NIL NIL)") -LISPOBJ(seclass_read,"(T NIL NIL)") -LISPOBJ(seclass_write,"(NIL T T)") -LISPOBJ(seclass_default,"(T T T)") + LISPOBJ(seclass_no_se,"(NIL NIL NIL)") + LISPOBJ(seclass_read,"(T NIL NIL)") + LISPOBJ(seclass_write,"(NIL T T)") + LISPOBJ(seclass_default,"(T T T)") # for FOREIGN.D: #ifdef DYNAMIC_FFI LISPOBJ(fp_zero,"NIL") --__--__-- Message: 3 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src places.lisp,1.43,1.44 NEWS,1.163,1.164 ChangeLog,1.3392,1.3393 Date: Sun, 08 Aug 2004 14:40:11 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28947/src Modified Files: places.lisp NEWS ChangeLog Log Message: Make SETF VALUES compliant to ANSI CL. Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.163 retrieving revision 1.164 diff -u -d -r1.163 -r1.164 --- NEWS 8 Aug 2004 14:38:17 -0000 1.163 +++ NEWS 8 Aug 2004 14:40:08 -0000 1.164 @@ -138,6 +138,7 @@ + DEFSETF lambda-lists now support &ENVIRONMENT. + DEFSETF lambda-lists are no longer destructuring lambda-lists. + NAMESTRING no longer accepts an optional second argument. + + SETF of VALUES now uses only the first value of each subform. Thanks to Paul F. Dietz <di...@dl...> and his ANSI compliance suite, which helped detect some of these deficiencies. Thanks to Yuji Minejima <ggb...@ni...> and his ANSI compliance Index: places.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/places.lisp,v retrieving revision 1.43 retrieving revision 1.44 diff -u -d -r1.43 -r1.44 --- places.lisp 23 Jun 2004 12:28:15 -0000 1.43 +++ places.lisp 8 Aug 2004 14:40:08 -0000 1.44 @@ -978,7 +978,12 @@ (get-setf-expansion (pop placesr) env) (setq temps (revappend SM1 temps)) (setq vals (revappend SM2 vals)) - (setq stores (revappend SM3 stores)) + (when SM3 + ;; See ANSI CL 5.1.2.3. + (dolist (extra-store (rest SM3)) + (push extra-store temps) + (push 'NIL vals)) + (push (first SM3) stores)) (setq storeforms (cons SM4 storeforms)) (setq accessforms (cons SM5 accessforms)) ) ) ) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3392 retrieving revision 1.3393 diff -u -d -r1.3392 -r1.3393 --- ChangeLog 8 Aug 2004 14:38:17 -0000 1.3392 +++ ChangeLog 8 Aug 2004 14:40:09 -0000 1.3393 @@ -1,5 +1,10 @@ 2004-08-07 Bruno Haible <br...@cl...> + * places.lisp (setf-VALUES-aux): Use only the first store variable + for each subform. Bind the others to nil. + +2004-08-07 Bruno Haible <br...@cl...> + * sacla-tests: New directory. * makemake.in (SACLATESTSDIR): New variable. (check-sacla-tests, ${SACLATESTSDIR}): New targets. --__--__-- Message: 4 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src package.d,1.83,1.84 defpackage.lisp,1.3,1.4 NEWS,1.164,1.165 ChangeLog,1.3393,1.3394 Date: Sun, 08 Aug 2004 14:41:30 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29077/src Modified Files: package.d defpackage.lisp NEWS ChangeLog Log Message: NIL as an argument to a package function designates the empty list. Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.164 retrieving revision 1.165 diff -u -d -r1.164 -r1.165 --- NEWS 8 Aug 2004 14:40:08 -0000 1.164 +++ NEWS 8 Aug 2004 14:41:27 -0000 1.165 @@ -139,6 +139,8 @@ + DEFSETF lambda-lists are no longer destructuring lambda-lists. + NAMESTRING no longer accepts an optional second argument. + SETF of VALUES now uses only the first value of each subform. + + (EXPORT NIL), (UNEXPORT NIL), (IMPORT NIL), (SHADOWING-IMPORT NIL), + (SHADOW NIL) are now nops. Thanks to Paul F. Dietz <di...@dl...> and his ANSI compliance suite, which helped detect some of these deficiencies. Thanks to Yuji Minejima <ggb...@ni...> and his ANSI compliance Index: package.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/package.d,v retrieving revision 1.83 retrieving revision 1.84 diff -u -d -r1.83 -r1.84 --- package.d 22 Jun 2004 22:48:02 -0000 1.83 +++ package.d 8 Aug 2004 14:41:27 -0000 1.84 @@ -2069,11 +2069,19 @@ test_optional_package_arg(); /* stack-layout: symarg, pack. */ /* apply fun to all symbols: */ - if (matomp(STACK_1)) { /* single symbol */ - /* stack-layout: sym, pack. */ - (*fun)(&STACK_1,&STACK_0); + if (matomp(STACK_1)) { + if (nullp(STACK_1)) { + /* ANSI CL 11.1.1. says + "Where an operator takes an argument that is either a symbol or a list of + symbols, an argument of nil is treated as an empty list of symbols." */ + } else { + /* single symbol */ + /* stack-layout: sym, pack. */ + (*fun)(&STACK_1,&STACK_0); + } skipSTACK(2); - } else { /* non-empty symbol-list */ + } else { + /* non-empty symbol-list */ pushSTACK(NIL); do { var object symlistr = STACK_2; Index: defpackage.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/defpackage.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- defpackage.lisp 23 Jun 2004 11:40:05 -0000 1.3 +++ defpackage.lisp 8 Aug 2004 14:41:27 -0000 1.4 @@ -154,12 +154,12 @@ sym ) ) (defun shadowing-import-cerror (string packname calling-packname) - (shadowing-import (find-symbol-cerror string packname calling-packname) - calling-packname + (let ((sym (find-symbol-cerror string packname calling-packname))) + (shadowing-import (or sym '(NIL)) calling-packname) ) ) (defun import-cerror (string packname calling-packname) - (import (find-symbol-cerror string packname calling-packname) - calling-packname + (let ((sym (find-symbol-cerror string packname calling-packname))) + (import (or sym '(NIL)) calling-packname) ) ) (defun intern-export (string-list packname) (export (mapcar #'(lambda (string) (intern string packname)) string-list) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3393 retrieving revision 1.3394 diff -u -d -r1.3393 -r1.3394 --- ChangeLog 8 Aug 2004 14:40:09 -0000 1.3393 +++ ChangeLog 8 Aug 2004 14:41:27 -0000 1.3394 @@ -1,5 +1,12 @@ 2004-08-07 Bruno Haible <br...@cl...> + * package.d (apply_symbols): Interpret an argument of nil as an empty + list, not as a single symbol. + * defpackage.lisp (shadowing-import-cerror, import-cerror): Handle + the NIL symbol accordingly. + +2004-08-07 Bruno Haible <br...@cl...> + * places.lisp (setf-VALUES-aux): Use only the first store variable for each subform. Bind the others to nil. --__--__-- Message: 5 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src condition.lisp,1.43,1.44 NEWS,1.165,1.166 ChangeLog,1.3394,1.3395 Date: Sun, 08 Aug 2004 14:43:36 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29361/src Modified Files: condition.lisp NEWS ChangeLog Log Message: For invalid condition designators, signal a TYPE-ERROR. Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.165 retrieving revision 1.166 diff -u -d -r1.165 -r1.166 --- NEWS 8 Aug 2004 14:41:27 -0000 1.165 +++ NEWS 8 Aug 2004 14:43:33 -0000 1.166 @@ -141,6 +141,8 @@ + SETF of VALUES now uses only the first value of each subform. + (EXPORT NIL), (UNEXPORT NIL), (IMPORT NIL), (SHADOWING-IMPORT NIL), (SHADOW NIL) are now nops. + + An attempt to create a condition from an invalid condition designator now + always results in a TYPE-ERROR being signalled. Thanks to Paul F. Dietz <di...@dl...> and his ANSI compliance suite, which helped detect some of these deficiencies. Thanks to Yuji Minejima <ggb...@ni...> and his ANSI compliance Index: condition.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/condition.lisp,v retrieving revision 1.43 retrieving revision 1.44 diff -u -d -r1.43 -r1.44 --- condition.lisp 24 Jun 2004 10:50:40 -0000 1.43 +++ condition.lisp 8 Aug 2004 14:43:33 -0000 1.44 @@ -139,9 +139,10 @@ (apply #'clos:make-instance type slot-initializations)) ;; canonicalize a condition argument, CLtL2 p. 888 -(defun coerce-to-condition (datum arguments - caller-name - default-type &rest more-initargs) + +(defun try-coerce-to-condition (datum arguments + caller-name + default-type &rest more-initargs) (typecase datum (condition (when arguments @@ -164,6 +165,27 @@ (TEXT "~S: the condition argument must be a string, a symbol or a condition, not ~S") caller-name datum)))) +(defun valid-condition-designator-p (datum+arguments) + (handler-case + (try-coerce-to-condition (car datum+arguments) (cdr datum+arguments) + 'coerce-to-condition 'simple-error) ; hmmpf + (ERROR () nil) + (:NO-ERROR (&rest values) (declare (ignore values)) t))) + +(defun coerce-to-condition (datum arguments + caller-name + default-type &rest more-initargs) + (handler-case + (apply #'try-coerce-to-condition datum arguments + caller-name default-type more-initargs) + (TYPE-ERROR (error) (signal error)) + (ERROR (error) + ;; ANSI CL wants a type error here. + (error-of-type 'type-error + :datum (cons datum arguments) + :expected-type '(satisfies valid-condition-designator-p) + "~A" error)))) + ;;; 29.5. Predefined Condition Types ; Hierarchy: Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3394 retrieving revision 1.3395 diff -u -d -r1.3394 -r1.3395 --- ChangeLog 8 Aug 2004 14:41:27 -0000 1.3394 +++ ChangeLog 8 Aug 2004 14:43:33 -0000 1.3395 @@ -1,5 +1,13 @@ 2004-08-07 Bruno Haible <br...@cl...> + For invalid condition designators, signal a TYPE-ERROR. + * condition.lisp (try-coerce-to-condition): Renamed from + coerce-to-condition. + (valid-condition-designator-p): New function. + (coerce-to-condition): New function. + +2004-08-07 Bruno Haible <br...@cl...> + * package.d (apply_symbols): Interpret an argument of nil as an empty list, not as a single symbol. * defpackage.lisp (shadowing-import-cerror, import-cerror): Handle --__--__-- Message: 6 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src io.d,1.239,1.240 NEWS,1.166,1.167 ChangeLog,1.3395,1.3396 Date: Sun, 08 Aug 2004 14:45:08 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29500/src Modified Files: io.d NEWS ChangeLog Log Message: Fix crash of (COPY-READTABLE NIL some-readtable). Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.166 retrieving revision 1.167 diff -u -d -r1.166 -r1.167 --- NEWS 8 Aug 2004 14:43:33 -0000 1.166 +++ NEWS 8 Aug 2004 14:45:03 -0000 1.167 @@ -175,6 +175,7 @@ + Passing a package as second argument of RENAME-PACKAGE led to an unjustified error. + Fixed ATANH on complex numbers. + + Fixed a crash of (COPY-READTABLE NIL some-readtable). Modules Index: io.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/io.d,v retrieving revision 1.239 retrieving revision 1.240 diff -u -d -r1.239 -r1.240 --- io.d 5 Aug 2004 11:15:24 -0000 1.239 +++ io.d 8 Aug 2004 14:44:54 -0000 1.240 @@ -572,7 +572,7 @@ } else { if (nullp(from_readtable)) /* instead of NIL take the standard-readtable */ - from_readtable = O(standard_readtable); + from_readtable = STACK_1 = O(standard_readtable); else /* check from-readtable: */ from_readtable = STACK_1 = check_readtable(from_readtable); /* from-readtable is OK */ Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3395 retrieving revision 1.3396 diff -u -d -r1.3395 -r1.3396 --- ChangeLog 8 Aug 2004 14:43:33 -0000 1.3395 +++ ChangeLog 8 Aug 2004 14:45:03 -0000 1.3396 @@ -1,5 +1,11 @@ 2004-08-07 Bruno Haible <br...@cl...> + Fix crash of (COPY-READTABLE NIL some-readtable). + * io.d (COPY-READTABLE): Store from_readtable in the STACK. Fixes bug + introduced on 2003-06-08. + +2004-08-07 Bruno Haible <br...@cl...> + For invalid condition designators, signal a TYPE-ERROR. * condition.lisp (try-coerce-to-condition): Renamed from coerce-to-condition. --__--__-- Message: 7 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src io.d,1.240,1.241 NEWS,1.167,1.168 ChangeLog,1.3396,1.3397 Date: Sun, 08 Aug 2004 14:46:27 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29639/src Modified Files: io.d NEWS ChangeLog Log Message: Signal READER-ERROR instead of STREAM-ERROR in some cases, to satisfy the sacla-tests. Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.167 retrieving revision 1.168 diff -u -d -r1.167 -r1.168 --- NEWS 8 Aug 2004 14:45:03 -0000 1.167 +++ NEWS 8 Aug 2004 14:46:24 -0000 1.168 @@ -143,6 +143,7 @@ (SHADOW NIL) are now nops. + An attempt to create a condition from an invalid condition designator now always results in a TYPE-ERROR being signalled. + + The reader's errors are now of type READER-ERROR when they should be. Thanks to Paul F. Dietz <di...@dl...> and his ANSI compliance suite, which helped detect some of these deficiencies. Thanks to Yuji Minejima <ggb...@ni...> and his ANSI compliance Index: io.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/io.d,v retrieving revision 1.240 retrieving revision 1.241 diff -u -d -r1.240 -r1.241 --- io.d 8 Aug 2004 14:44:54 -0000 1.240 +++ io.d 8 Aug 2004 14:46:24 -0000 1.241 @@ -1880,7 +1880,7 @@ pushSTACK(ch); # Mainchar pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, # ANSI CL spec of MAKE-DISPATCH-MACRO-CHARACTER wants a reader-error here GETTEXT("~S from ~S: After ~S is ~S an undefined dispatch macro character")); } pushSTACK(*stream_); # Stream as 1. argument @@ -1958,7 +1958,7 @@ pushSTACK(*stream_); # STREAM-ERROR slot STREAM pushSTACK(*stream_); pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, # ANSI CL 2.4.9. wants a reader-error here GETTEXT("~S from ~S: a token consisting only of dots cannot be meaningfully read in")); } # Length=1 -> dot_value as value @@ -2175,7 +2175,8 @@ pushSTACK(stream); # STREAM-ERROR slot STREAM pushSTACK(stream); # Stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: token \".\" not allowed here")); + fehler(reader_error, # ANSI CL 2.3.3. wants a reader-error here. + GETTEXT("~S from ~S: token \".\" not allowed here")); } # UP: reads an Object, with SYS::*READ-RECURSIVE-P* /= NIL @@ -3206,7 +3207,7 @@ pushSTACK(*stream_); # STREAM-ERROR slot STREAM pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, # ANSI CL 2.4.8.4. wants a reader-error here GETTEXT("~S from ~S: only zeroes and ones are allowed after #*")); } var object buff_1 = O(token_buff_1); # Character-Buffer @@ -3233,7 +3234,7 @@ pushSTACK(STACK_(0+1)); # n pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, # ANSI CL 2.4.8.4. wants a reader-error here GETTEXT("~S from ~S: bit vector is longer than the explicitly given length ~S")); } if ((n>0) && (len==0)) { @@ -3241,7 +3242,7 @@ pushSTACK(STACK_(0+1)); # n pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, # ANSI CL 2.4.8.4. wants a reader-error here GETTEXT("~S from ~S: must specify element of bit vector of length ~S")); } } @@ -3470,7 +3471,7 @@ pushSTACK(S(read_eval)); # *READ-EVAL* pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, # ANSI CL 2.4.8.6. wants a reader-error here GETTEXT("~S from ~S: ~S = ~S does not allow the evaluation of ~S")); } @@ -3703,7 +3704,7 @@ pushSTACK(*stream_); # STREAM-ERROR slot STREAM pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, # ANSI CL 2.4.8.20. wants a reader-error here GETTEXT("~S from ~S: objects printed as #<...> cannot be read back in")); } @@ -3719,7 +3720,7 @@ pushSTACK(S(print_level)); pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, # ANSI CL 2.4.9. wants a reader-error here GETTEXT("~S from ~S: objects printed as #"" in view of ~S cannot be read back in")); } Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3396 retrieving revision 1.3397 diff -u -d -r1.3396 -r1.3397 --- ChangeLog 8 Aug 2004 14:45:03 -0000 1.3396 +++ ChangeLog 8 Aug 2004 14:46:24 -0000 1.3397 @@ -1,5 +1,11 @@ 2004-08-07 Bruno Haible <br...@cl...> + * io.d (read_macro, read_internal, fehler_dot, bit_vector_reader, + fehler_read_eval_forbidden, not_readable_reader, syntax_error_reader): + Signal READER-ERROR instead of STREAM-ERROR in some cases. + +2004-08-07 Bruno Haible <br...@cl...> + Fix crash of (COPY-READTABLE NIL some-readtable). * io.d (COPY-READTABLE): Store from_readtable in the STACK. Fixes bug introduced on 2003-06-08. --__--__-- Message: 8 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src io.d,1.241,1.242 ChangeLog,1.3397,1.3398 Date: Sun, 08 Aug 2004 14:47:18 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29775/src Modified Files: io.d ChangeLog Log Message: Signal READER-ERROR instead of STREAM-ERROR in all cases. Index: io.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/io.d,v retrieving revision 1.241 retrieving revision 1.242 diff -u -d -r1.241 -r1.242 --- io.d 8 Aug 2004 14:46:24 -0000 1.241 +++ io.d 8 Aug 2004 14:47:15 -0000 1.242 @@ -1235,7 +1235,8 @@ pushSTACK(ch); # character pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: illegal character ~S")); + fehler(reader_error, # ANSI CL 2.2. wants a reader-error here + GETTEXT("~S from ~S: illegal character ~S")); break; case syntax_single_esc: # Single-Escape-Character -> # read next character and take over unchanged @@ -1813,7 +1814,7 @@ pushSTACK(ch); pushSTACK(*stream_); pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: ~S has no macro character definition")); } if (!simple_vector_p(macrodef)) { # a simple-vector? @@ -2064,7 +2065,7 @@ pushSTACK(copy_string(O(token_buff_1))); # copy Character-Buffer pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: too many colons in token ~S")); + fehler(reader_error,GETTEXT("~S from ~S: too many colons in token ~S")); # search Symbol or create it: current: # search Symbol in the current package. # Symbolname = O(token_buff_1) = (subseq O(token_buff_1) 0 len) @@ -2235,7 +2236,7 @@ pushSTACK(obj); pushSTACK(bad_reference); pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S: no entry for ~S from ~S in ~S = ~S")); + fehler(reader_error,GETTEXT("~S: no entry for ~S from ~S in ~S = ~S")); } return popSTACK(); } @@ -2441,7 +2442,7 @@ pushSTACK(*stream_); # STREAM-ERROR slot STREAM pushSTACK(*stream_); # Stream pushSTACK(S(read_delimited_list)); - fehler(stream_error,GETTEXT("~S from ~S: illegal end of dotted list")); + fehler(reader_error,GETTEXT("~S from ~S: illegal end of dotted list")); } if (scode < syntax_t_macro) { # Macro-Character? # no -> read last Objekt: @@ -2511,7 +2512,7 @@ pushSTACK(STACK_(0+1)); # char pushSTACK(*stream_); # stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: an object cannot start with ~S")); + fehler(reader_error,GETTEXT("~S from ~S: an object cannot start with ~S")); } # (set-macro-character #\" @@ -2672,7 +2673,7 @@ pushSTACK(STACK_(0+1)); # sub-char pushSTACK(STACK_(1+2)); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: no number allowed between #"" and ~C")); } @@ -2846,7 +2847,7 @@ pushSTACK(STACK_(0+1)); # n pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: font number ~S for character is too large, should be = 0")); + fehler(reader_error,GETTEXT("~S from ~S: font number ~S for character is too large, should be = 0")); } # Font ready. var object token = O(token_buff_1); # read Token as Semi-Simple-String @@ -2910,7 +2911,7 @@ pushSTACK(copy_string(hstring)); # copy Charactername pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: there is no character with name ~S")); } # found @@ -2969,7 +2970,7 @@ pushSTACK(copy_string(O(token_buff_1))); # Token pushSTACK(STACK_(2+4)); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: token ~S after #~C is not a rational number in base ~S")); default: NOTREACHED; } @@ -3039,7 +3040,7 @@ pushSTACK(*stream_); # STREAM-ERROR slot STREAM pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: the number base must be given between #"" and R")); } var uintL base; @@ -3052,7 +3053,7 @@ pushSTACK(STACK_(0+1)); # n pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: The base ~S given between #"" and R should lie between 2 and 36")); } } @@ -3098,7 +3099,7 @@ pushSTACK(obj); # Object pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: bad syntax for complex number: #C~S")); } @@ -3130,7 +3131,7 @@ pushSTACK(*stream_); # STREAM-ERROR slot STREAM pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: token expected after #:")); + fehler(reader_error,GETTEXT("~S from ~S: token expected after #:")); } # read Token until the end: read_token_1(stream_,ch,scode); @@ -3156,7 +3157,7 @@ pushSTACK(string); # Token pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: token ~S after #: should contain no colon")); } @@ -3318,7 +3319,7 @@ pushSTACK(STACK_(0+1)); # n pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: vector is longer than the explicitly given length ~S")); } if ((n>0) && (len==0)) { @@ -3326,7 +3327,7 @@ pushSTACK(STACK_(0+1)); # n pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: must specify element of vector of length ~S")); } } @@ -3409,7 +3410,7 @@ pushSTACK(obj); # Object pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: bad syntax for array: #A~S")); + fehler(reader_error,GETTEXT("~S from ~S: bad syntax for array: #A~S")); } # n specifies the Rank of the Arrays. # read content: @@ -3593,7 +3594,7 @@ pushSTACK(STACK_(1+1)); # sub-char pushSTACK(STACK_(2+2)); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: a number must be given between #"" and ~C")); } # n is an Integer >=0 @@ -3603,7 +3604,7 @@ pushSTACK(STACK_(0+2)); # n pushSTACK(STACK_(2+3)); # Stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: label #~S? too large")); + fehler(reader_error,GETTEXT("~S from ~S: label #~S? too large")); } var object label = make_read_label(posfixnum_to_L(n)); # Internal-Label with Nummer n var object alist = # value of SYS::*READ-REFERENCE-TABLE* @@ -3641,7 +3642,7 @@ pushSTACK(STACK_(0+1)); # n pushSTACK(STACK_(2+2)); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: label #~S= may not be defined twice")); } else { # lookup = label, not jeopardized by GC. @@ -3667,7 +3668,7 @@ pushSTACK(STACK_(0+2)); # n pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: #~S= #~S#"" is illegal")); + fehler(reader_error,GETTEXT("~S from ~S: #~S= #~S#"" is illegal")); } # insert read Objekt as (cdr h): Cdr(h) = obj; @@ -3690,7 +3691,7 @@ pushSTACK(STACK_(0+1)); # n pushSTACK(STACK_(2+2)); # Stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: undefined label #~S#")); + fehler(reader_error,GETTEXT("~S from ~S: undefined label #~S#")); } } @@ -3790,7 +3791,7 @@ pushSTACK(expr); # Feature-Expression pushSTACK(STACK_(1+2)); # Stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: illegal feature ~S")); + fehler(reader_error,GETTEXT("~S from ~S: illegal feature ~S")); } # UP: for #+ und #- @@ -3913,7 +3914,7 @@ pushSTACK(args); # Arguments pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: #S must be followed by the type and the contents of the structure, not ~S")); } { @@ -3925,7 +3926,7 @@ pushSTACK(name); pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: the type of a structure should be a symbol, not ~S")); } pushSTACK(name); @@ -3937,7 +3938,7 @@ if (!consp(args)) { pushSTACK(*stream_); # STREAM-ERROR slot STREAM pushSTACK(S(hash_table)); pushSTACK(*stream_); pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: bad ~S")); + fehler(reader_error,GETTEXT("~S from ~S: bad ~S")); } if (symbolp(Car(args)) && keywordp(Car(args))) { # New syntax with implicit :INITIAL-CONTENTS keyword: @@ -3978,7 +3979,7 @@ pushSTACK(name); pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: bad ~S")); + fehler(reader_error,GETTEXT("~S from ~S: bad ~S")); } STACK_0 = Car(args); # save Simple-Bit-Vector var object ergebnis = allocate_random_state(); # new Random-State @@ -4008,7 +4009,7 @@ pushSTACK(name); pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: no structure of type ~S has been defined")); } # description must be a Simple-Vector of length >=5: @@ -4018,7 +4019,7 @@ pushSTACK(S(defstruct_description)); pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: bad ~S for ~S")); + fehler(reader_error,GETTEXT("~S from ~S: bad ~S for ~S")); } # fetch constructor-function: var object constructor = # (svref description 3) @@ -4028,7 +4029,7 @@ pushSTACK(name); pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: structures of type ~S cannot be read in, missing constructor function")); } # call constructor-function with adapted Argumentlist: @@ -4049,7 +4050,7 @@ pushSTACK(*(stream_ STACKop -2)); # name pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: a structure ~S may not contain a component \".\"")); } { @@ -4060,7 +4061,7 @@ pushSTACK(slot); pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: ~S is not a symbol, not a slot name of structure ~S")); } if (nullp(Cdr(args))) { @@ -4069,7 +4070,7 @@ pushSTACK(slot); pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: missing value of slot ~S in structure ~S")); } if (matomp(Cdr(args))) @@ -4090,7 +4091,7 @@ pushSTACK(*(stream_ STACKop -2)); # name pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: too many slots for structure ~S")); + fehler(reader_error,GETTEXT("~S from ~S: too many slots for structure ~S")); } } funcall(*(stream_ STACKop -3),argcount); # call constructor @@ -4133,7 +4134,7 @@ pushSTACK(STACK_(0+1)); # n pushSTACK(STACK_(2+2)); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: illegal syntax of closure code vector after #~SY")); } @@ -4182,7 +4183,7 @@ pushSTACK(obj); pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error, + fehler(reader_error, GETTEXT("~S from ~S: object #Y~S has not the syntax of a compiled closure")); } skipSTACK(3); @@ -4322,7 +4323,7 @@ pushSTACK(obj); # Object pushSTACK(*stream_); # Stream pushSTACK(S(read)); - fehler(stream_error,GETTEXT("~S from ~S: bad syntax for pathname: #P~S")); + fehler(reader_error,GETTEXT("~S from ~S: bad syntax for pathname: #P~S")); } } Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3397 retrieving revision 1.3398 diff -u -d -r1.3397 -r1.3398 --- ChangeLog 8 Aug 2004 14:46:24 -0000 1.3397 +++ ChangeLog 8 Aug 2004 14:47:15 -0000 1.3398 @@ -1,3 +1,13 @@ +2004-08-08 Bruno Haible <br...@cl...> + + * io.d (read_token_1, read_macro, read_internal, make_references, + read_delimited_list_recursive, rpar_reader, fehler_dispatch_zahl, + char_reader, radix_2, radix_reader, complex_reader, uninterned_reader, + vector_reader, array_reader, lookup_label, label_definition_reader, + label_reference_reader, interpret_feature, structure_reader, + fehler_closure_badchar, closure_reader, ansi_pathname_reader): Signal + READER-ERROR instead of STREAM-ERROR in all cases. + 2004-08-07 Bruno Haible <br...@cl...> * io.d (read_macro, read_internal, fehler_dot, bit_vector_reader, --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |