From: Lars B. <la...@no...> - 2006-08-10 13:32:29
|
[I tried to submit this bug report to SourceForge, but it complained about logging in, so I gave up.] The CLHS page for ADJUST-ARRAY says: An error of type error is signaled if fill-pointer is supplied and non-nil but array has no fill pointer. However, CLISP says: [1]> (lisp-implementation-version) "2.39 (2006-07-16) (built 3364196085) (memory 3364203222)" [2]> "foo" "foo" [3]> (array-has-fill-pointer-p *) NIL [4]> (adjust-array ** 3 :fill-pointer t) "foo" [5]> (array-has-fill-pointer-p *) T uname -a: Linux kaneda 2.4.19-rmk7-nw1 #2 Wed Aug 6 11:01:40 CEST 2003 armv4l GNU/Linux Source code from: ftp.gnu.org, 2006-08-10 Build: >From scratch, no interesting options. --version: GNU CLISP 2.39 (2006-07-16) (built 3364196085) (memory 3364203222) Software: GNU C 3.3.5 (Debian 1:3.3.5-13) gcc -Os -g -O2 -W -Wswitch -Wcomment -Wpointer-arith -Wimplicit -Wreturn-type -Wmissing-declarations -Wno-sign-compare -O2 -DUNICODE -I. -x none libcharset.a -lreadline -lncurses -ldl -lsigsegv SAFETY=0 HEAPCODES STANDARD_HEAPCODES GENERATIONAL_GC SPVW_BLOCKS SPVW_MIXED TRIVIALMAP_MEMORY libreadline 4.3 Features: (REGEXP SYSCALLS I18N LOOP COMPILER CLOS MOP CLISP ANSI-CL COMMON-LISP LISP=CL INTERPRETER SOCKETS GENERIC-STREAMS LOGICAL-PATHNAMES SCREEN GETTEXT UNICODE BASE-CHAR=CHARACTER UNIX) C Modules: (clisp i18n syscalls regexp) Installation directory: /usr/local/lib/clisp/ User language: ENGLISH Machine: ARMV4L (ARMV4L) kaneda.nocrew.org [194.236.2.3] |
From: Sam S. <sd...@gn...> - 2006-08-10 20:27:22
|
Lars Brinkhoff wrote: > [I tried to submit this bug report to SourceForge, but it complained > about logging in, so I gave up.] yes, you need an SF account to submit bugs there - otherwise we cannot get back to you if we need more information. > The CLHS page for ADJUST-ARRAY says: > > An error of type error is signaled if fill-pointer is supplied and > non-nil but array has no fill pointer. > > However, CLISP says: > > [1]> (lisp-implementation-version) > "2.39 (2006-07-16) (built 3364196085) (memory 3364203222)" > [2]> "foo" > "foo" > [3]> (array-has-fill-pointer-p *) > NIL > [4]> (adjust-array ** 3 :fill-pointer t) > "foo" > [5]> (array-has-fill-pointer-p *) > T Interesting. I would think that the error requirement applies only if the array is modified, not when a new array is created. Maybe we should discuss this on comp.lang.lisp? note that both cmucl and sbcl are even weirder: they do the exact same thing except that last form returns NIL! gcl signal an error as the spec appears to require. how about acl? lw? thanks. Sam. |
From: Sam S. <sd...@gn...> - 2006-08-10 21:41:02
|
Lars Brinkhoff wrote: > The CLHS page for ADJUST-ARRAY says: > > An error of type error is signaled if fill-pointer is supplied and > non-nil but array has no fill pointer. > > However, CLISP says: > > [1]> (lisp-implementation-version) > "2.39 (2006-07-16) (built 3364196085) (memory 3364203222)" > [2]> "foo" > "foo" > [3]> (array-has-fill-pointer-p *) > NIL > [4]> (adjust-array ** 3 :fill-pointer t) > "foo" please try this patch: --- array.d 17 May 2006 08:54:49 -0400 1.107 +++ array.d 10 Aug 2006 17:39:23 -0400 @@ -3741,6 +3741,14 @@ VALUES_IF(array_has_fill_pointer_p(array)); } +/* signal an error when the vector does not have a fill pointer */ +nonreturning_function(local,fehler_no_fillp,(object vec)) { + pushSTACK(vec); /* TYPE-ERROR slot DATUM */ + pushSTACK(O(type_vector_with_fill_pointer)); /* TYPE-ERROR slot EXPECTED-TYPE */ + pushSTACK(vec); pushSTACK(TheSubr(subr_self)->name); + fehler(type_error,GETTEXT("~S: vector ~S has no fill pointer")); +} + /* check, if object is a vector with fill-pointer, and returns the address of the fill-pointer. *get_fill_pointer(obj) is the fill-pointer itself. @@ -3749,22 +3757,13 @@ /* obj must be a vector: */ if (!vectorp(obj)) fehler_vector(obj); - /* must not be simple: */ - if (simplep(obj)) - goto fehler_fillp; - /* must contain a fill-pointer: */ - if (!(Iarray_flags(obj) & bit(arrayflags_fillp_bit))) - goto fehler_fillp; + /* must not be simple & must have a fill-pointer */ + if (simplep(obj) || !(Iarray_flags(obj) & bit(arrayflags_fillp_bit))) + fehler_no_fillp(obj); /* where is the fill-pointer? */ return ((Iarray_flags(obj) & bit(arrayflags_dispoffset_bit)) ? &TheIarray(obj)->dims[2] /* behind displaced-offset and dimension 0 */ : &TheIarray(obj)->dims[1]); /* behind dimension 0 */ - fehler_fillp: - /* error-message: */ - pushSTACK(obj); /* TYPE-ERROR slot DATUM */ - pushSTACK(O(type_vector_with_fill_pointer)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - fehler(type_error,GETTEXT("~S: vector ~S has no fill pointer")); } LISPFUNNR(fill_pointer,1) { /* (FILL-POINTER vector), CLTL p. 296 */ @@ -4887,10 +4886,13 @@ if no :initial-contents and no :displaced-to, copy contents */ var bool copy_p = !boundp(STACK_3) && missingp(STACK_1); var object array = STACK_6; + var bool has_fill_p = array_has_fill_pointer_p(array); + if (!has_fill_p && !missingp(STACK_2)) + fehler_no_fillp(array); pushSTACK(STACK_1); pushSTACK(STACK_1); /* :FILL-POINTER NIL means keep it as it was */ - STACK_2 = !missingp(STACK_4) ? (object)STACK_4 : - array_has_fill_pointer_p(array) ? fixnum(*get_fill_pointer(array)) : NIL; + STACK_2 = (!missingp(STACK_4) ? (object)STACK_4 : + has_fill_p ? fixnum(*get_fill_pointer(array)) : NIL); STACK_3 = STACK_5; STACK_4 = STACK_6; STACK_5 = STACK_7; STACK_6 = NIL; /* :ADJUSTABLE NIL */ STACK_7 = STACK_9; /* dims */ @@ -5002,13 +5004,8 @@ /* modify the given array. */ if (!nullp(STACK_2)) { /* fill-pointer supplied? */ /* array must have fill-pointer: */ - if (!(Iarray_flags(STACK_6) & bit(arrayflags_fillp_bit))) { - pushSTACK(STACK_6); /* TYPE-ERROR slot DATUM */ - pushSTACK(O(type_vector_with_fill_pointer)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(STACK_(6+2)); - pushSTACK(TheSubr(subr_self)->name); - fehler(type_error,GETTEXT("~S: array ~S has no fill-pointer")); - } + if (!(Iarray_flags(STACK_6) & bit(arrayflags_fillp_bit))) + fehler_no_fillp(STACK_6); fillpointer = test_fillpointer(totalsize); /* fill-pointer-value */ } else { /* If array has a fill-pointer, it must be <= the new total-size: */ |