Custom Query (1030 matches)

(progn (set-pprint-dispatch '(eql foo) #'(lambda (s o) o (format s "<Bar>"))) (write 'foo :pretty t) (terpri))"
Fails with a low-level error.

It works on all other implementations at my command-line:

for l in sbcl cmucl clisp ecl abcl xcl gclcvs allegro lispworks scl ccl ; do echo $l ;  cl -l $l -i "(progn (set-pprint-dispatch '(eql foo) #'(lambda (s o) o (format s \"<Bar>\"))) (write 'foo :pretty t) (terpri))" ; done

Relevant excerpt from the CCL backtrace:

> Error of type TYPE-ERROR: value NIL is not of the expected type STRUCTURE.
> While executing: CCL::SET-PPRINT-DISPATCH+, in process listener(1).
 (7FDFC28156E0) : 0 (PRINT-CALL-HISTORY :CONTEXT NIL :PROCESS NIL :ORIGIN NIL :DETAILED-P T :COUNT 1152921504606846975 :START-FRAME-NUMBER 0 :STREAM #<SYNONYM-STREAM to *TERMINAL-IO* #x3020006A281D> :PRINT-LEVEL 2 :PRINT-LENGTH 5 :SHOW-INTERNAL-FRAMES NIL :FORMAT :TRADITIONAL) 861
  (&KEY :CONTEXT :PROCESS :ORIGIN :DETAILED-P :COUNT :START-FRAME-NUMBER :STREAM :PRINT-LEVEL :PRINT-LENGTH :SHOW-INTERNAL-FRAMES :FORMAT)
   CCL::CONTEXT: NIL
   PROCESS: NIL
   CCL::ORIGIN: NIL
   CCL::DETAILED-P: T
   COUNT: 1152921504606846975
   CCL::START-FRAME-NUMBER: 0
   STREAM: #<SYNONYM-STREAM to *TERMINAL-IO* #x3020006A281D>
   CCL::PRINT-LEVEL: 2
   CCL::PRINT-LENGTH: 5
   CCL::SHOW-INTERNAL-FRAMES: NIL
   FORMAT: :TRADITIONAL

  CCL::FRAME-NUMBER: 0
  *BACKTRACE-PRINT-LEVEL*: 2
  *BACKTRACE-PRINT-LENGTH*: 5
  *BACKTRACE-FORMAT*: :TRADITIONAL
  *STANDARD-OUTPUT*: #<SYNONYM-STREAM to *TERMINAL-IO* #x3020006A281D>
  *PRINT-CIRCLE*: NIL

 (7FDFC2815848) : 1 (ABNORMAL-APPLICATION-EXIT) 269
  NIL

  #:G137218: (ERROR)
  CCL::%HANDLERS%: ((ERROR) (PROCESS-RESET))

 (7FDFC2815878) : 2 (BREAK-LOOP-HANDLE-ERROR #<TYPE-ERROR #x30200074768D> 17574877211466) 1461
  (CONDITION *TOP-ERROR-FRAME*)
   CONDITION: #<TYPE-ERROR #x30200074768D>
   *TOP-ERROR-FRAME*: 17574877211466

  CCL::BOGUS-GLOBALS: NIL
  CCL::NEWVALS: NIL
  CCL::OLDVALS: NIL

 (7FDFC28158F0) : 3 (%ERROR #<TYPE-ERROR #x30200074768D> NIL 17574877211466) 357
  (CONDITION CCL::ARGS CCL::ERROR-POINTER)
   CONDITION: #<TYPE-ERROR #x30200074768D>
   CCL::ARGS: NIL
   CCL::ERROR-POINTER: 17574877211466



 (7FDFC2815918) : 4 (FUNCALL #'#<(:INTERNAL CCL::%XERR-DISP)>) 4269
  NIL

  CCL::FRAME-PTR: 17574877211466
  CCL::FN: #<Compiled-function CCL::SET-PPRINT-DISPATCH+ #x300000B0C3EF>
  CCL::OP0: 205
  CCL::OP1: 220
  CCL::OP2: 54
  CCL::SKIP: -1
  CCL::TYPENAME: STRUCTURE
  CCL::XP: #<A Foreign Pointer #x7FDFC2A794D0>
  CCL::XCF: #<A Foreign Pointer #x7FDFC2815A50>

 (7FDFC2815970) : 5 (FUNCALL-WITH-ERROR-REENTRY-DETECTION #<COMPILED-LEXICAL-CLOSURE (:INTERNAL CCL::%XERR-DISP) #x7FDFC40A726F>) 181
  (CCL::THUNK)
   CCL::THUNK: #<COMPILED-LEXICAL-CLOSURE (:INTERNAL CCL::%XERR-DISP) #x7FDFC40A726F>

  COUNT: 0
  CCL::*ERROR-REENTRY-COUNT*: 0

 (7FDFC28159B0) : 6 (FUNCALL #'#<CCL::%XERR-DISP> 17574877524464) 549
  (#:G149901)
   #:G149901: 17574877524464

  #:G149910: #<A Foreign Pointer [stack-allocated] #x7FDFC2A78F80>
  CCL::XP: #<A Foreign Pointer #x7FDFC2A794D0>
  CCL::XCF: #<A Foreign Pointer #x7FDFC2815A50>
  #:G149911: #<COMPILED-LEXICAL-CLOSURE (:INTERNAL CCL::%XERR-DISP) #x7FDFC40A726F>

 (7FDFC28159E8) : 7 (%PASCAL-FUNCTIONS% 2 17574877524464) 397
  (CCL::INDEX CCL::ARGS-PTR-FIXNUM)
   CCL::INDEX: 2
   CCL::ARGS-PTR-FIXNUM: 17574877524464

  CCL::LISP-FUNCTION: #<Compiled-function CCL::%XERR-DISP (Non-Global)  #x3000005A1EDF>
  WITHOUT-INTERRUPTS: NIL
  CCL::*CALLBACK-TRACE-P*: NIL

*(7FDFC2815A50) : 8 (SET-PPRINT-DISPATCH+ (EQL FOO) #<Anonymous Function #x30200075630F> 0 NIL) 1273
  (CCL::TYPE-SPECIFIER FUNCTION CCL::PRIORITY CCL::TABLE)
   CCL::TYPE-SPECIFIER: (EQL FOO)
   FUNCTION: #<Anonymous Function #x30200075630F>
   CCL::PRIORITY: 0
   CCL::TABLE: NIL

  CCL::CATEGORY: CCL::OTHER
  CCL::PRED: #<Anonymous Function #x3020007477BF>
  CCL::ENTRY: #<CCL::ENTRY #x30200074776D>

 (7FDFC2815B00) : 9 (CALL-CHECK-REGS SET-PPRINT-DISPATCH (EQL FOO) #<Anonymous Function #x30200075630F>) 221
  (CCL::FN &REST CCL::ARGS)
   CCL::FN: SET-PPRINT-DISPATCH
   CCL::ARGS: ((EQL FOO) #<Anonymous Function #x30200075630F>)

  CCL::OLD-REGS: ((# #) (SET-PPRINT-DISPATCH # #) #<CCL::LEXICAL-ENVIRONMENT #x30200072143D> CCL::*LOADING-TOPLEVEL-LOCATION*)

 (7FDFC2815B38) : 10 (FUNCALL #'#<(:INTERNAL CCL::PROGN-IN-ENV CCL::CHEAP-EVAL-IN-ENVIRONMENT)> ((SET-PPRINT-DISPATCH # #) (WRITE # :PRETTY T) (TERPRI)) NIL NIL) 293
  (CCL::BODY&DECLS CCL::PARSE-ENV CCL::BASE-ENV)
   CCL::BODY&DECLS: ((SET-PPRINT-DISPATCH # #) (WRITE # :PRETTY T) (TERPRI))
   CCL::PARSE-ENV: NIL
   CCL::BASE-ENV: NIL

  CCL::BODY: (LAMBDA (CCL::X) (TYPEP CCL::X #))
  CCL::DECLS: NIL
  CCL::DEFAULT-LOCATION: NIL
  CCL::FORM: #<CCL::ENTRY #x30200074776D>

We are experiencing a bug trying to compile QRes with coverage, ever since we upgraded from 1.7-15111 to 1.8-15359. Happily, the bug is reproducible with code that is freely available.

1- Use git to grab a checkout of QUUX-TIME from ​http://common-lisp.net/project/qitab/

2- Create a file ccl-coverage.lisp as follows (configuring the path as necessary to point to your checkout if it's not already in your source-registry):

(require :asdf)
(pushnew #p"/home/tunes/cl/quux-time/" asdf:*central-registry*)
(require :cover)
(setq ccl:*compile-code-coverage* t)
(proclaim '(optimize (SPEED 1) (SPACE 1) (SAFETY 1) (DEBUG 2) (COMPILATION-SPEED 1)))
(asdf:load-system :quux-time)

Now you can run ccl --load ccl-coverage.lisp and you'll get the following error:

> Error: value #<CODE-NOTE [0] #x302000BE767D> is not of the expected type FIXNUM.
> While executing: %DAYS-UNTIL-YEAR-MONTH, in process listener(1).
> Type :GO to continue, :POP to abort, :R for a list of available restarts.
> If continued: Skip loading "/home/tunes/bug/ccl-coverage.lisp"
> Type :? for other options.
1 > :b
*(7F50445ACFA0) : 0 (%DAYS-UNTIL-YEAR-MONTH 1900 3) 203
 (7F50445AD008) : 1 (FUNCALL #'#<Anonymous Function #x302000C1AE4F>) 445
 (7F50445AD038) : 2 (FUNCALL #'#<CCL::$FASL-LFUNCALL> #<CCL::FASLSTATE #x7F504561B74D>) 77
 (7F50445AD058) : 3 (%FASLOAD "/ita/local/var/cache/common-lisp/ccl-1.8-f95-linux-x64/home/tunes/cl/quux-time/time.lx64fsl" #(#<Compiled-function CCL::$FASL-NOOP (Non-Global)  #x3000000F749F> #<Compiled-function CCL::$FASL-S32-VECTOR (Non-Global)  #x3000000F74FF> CCL::%BAD-FASL #<Compiled-function CCL::$FASL-CLFUN (Non-Global)  #x3000000F756F> #<Compiled-function CCL::$FASL-LFUNCALL (Non-Global)  #x3000000F775F> ...)) 1277
 (7F50445AD0F0) : 4 (%LOAD #P"/ita/local/var/cache/common-lisp/ccl-1.8-f95-linux-x64/home/tunes/cl/quux-time/time.lx64fsl" NIL NIL :ERROR :DEFAULT) 3717
 (7F50445AD270) : 5 (LOAD #P"/ita/local/var/cache/common-lisp/ccl-1.8-f95-linux-x64/home/tunes/cl/quux-time/time.lx64fsl" :VERBOSE NIL :PRINT NIL :IF-DOES-NOT-EXIST :ERROR :EXTERNAL-FORMAT :DEFAULT) 1013
 (7F50445AD308) : 6 (MAP NIL #<Compiled-function LOAD #x30000012D3EF> (#P"/ita/local/var/cache/common-lisp/ccl-1.8-f95-linux-x64/home/tunes/cl/quux-time/time.lx64fsl")) 741
 (7F50445AD378) : 7 (%%BEFORE-AND-AFTER-COMBINED-METHOD-DCODE (NIL #<STANDARD-METHOD ASDF:PERFORM #> . 17497840114312)) 845
 (7F50445AD3E8) : 8 (%%STANDARD-COMBINED-METHOD-DCODE (NIL (#<#>) #<STANDARD-METHOD ASDF:PERFORM #>) 17497840114312) 261
 (7F50445AD458) : 9 (%CALL-NEXT-METHOD (NIL #<STANDARD-METHOD ASDF::PERFORM-WITH-RESTARTS #> . 17497840114383)) 1053
 (7F50445AD4D8) : 10 (FUNCALL #'#<#<STANDARD-METHOD ASDF::PERFORM-WITH-RESTARTS (ASDF:LOAD-OP ASDF:CL-SOURCE-FILE)>> #<LOAD-OP NIL #x302000972B6D> #<CL-SOURCE-FILE "quux-time" "time">) 517
 (7F50445AD538) : 11 (%CALL-NEXT-METHOD (NIL #<STANDARD-METHOD ASDF::PERFORM-WITH-RESTARTS #> . 17497840114383)) 1053
 (7F50445AD5B8) : 12 (FUNCALL #'#<#<STANDARD-METHOD ASDF::PERFORM-WITH-RESTARTS :AROUND (T T)>> #<LOAD-OP NIL #x302000972B6D> #<CL-SOURCE-FILE "quux-time" "time">) 677
 (7F50445AD620) : 13 (%%STANDARD-COMBINED-METHOD-DCODE (#<STANDARD-METHOD ASDF::PERFORM-WITH-RESTARTS :AROUND #> #<STANDARD-METHOD ASDF::PERFORM-WITH-RESTARTS #> #<STANDARD-METHOD ASDF::PERFORM-WITH-RESTARTS #>) 17497840114383) 765
 (7F50445AD690) : 14 (FUNCALL #'#<(:INTERNAL CCL::WITH-COMPILATION-UNIT-BODY (ASDF::PERFORM-PLAN (LIST)))>) 125
 (7F50445AD6C8) : 15 (CALL-WITH-COMPILATION-UNIT #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL CCL::WITH-COMPILATION-UNIT-BODY #) #x7F504561BF8F> :OVERRIDE NIL) 197
 (7F50445AD710) : 16 (FUNCALL #'#<#<STANDARD-METHOD ASDF::PERFORM-PLAN (LIST)>> ((#<# # #x302000972B6D> . #<# # #>) (#<# # #x302000972B6D> . #<# # #>) (#<# # #x302000972B6D> . #<# # #>) (#<# # #x302000972B6D> . #<# #>))) 389
 (7F50445AD778) : 17 (%%CHECK-KEYWORDS #(1 #() #<CCL:METHOD-FUNCTION ASDF::PERFORM-PLAN #>) 17497840114426) 229
 (7F50445AD7E0) : 18 (FUNCALL #'#<(:INTERNAL (ASDF:OPERATE (T T)))>) 1325
 (7F50445AD858) : 19 (CALL-WITH-SYSTEM-DEFINITIONS #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL #) #x3020009731BF>) 205
 (7F50445AD890) : 20 (FUNCALL #'#<#<STANDARD-METHOD ASDF:OPERATE (T T)>> ASDF:LOAD-OP :QUUX-TIME) 477
 (7F50445AD910) : 21 (%%STANDARD-COMBINED-METHOD-DCODE ((#<#>) NIL #<STANDARD-METHOD ASDF:OPERATE #>) 17497840114476) 261
 (7F50445AD978) : 22 (LOAD-SYSTEM :QUUX-TIME) 173
 (7F50445AD9C8) : 23 (CALL-CHECK-REGS ASDF:LOAD-SYSTEM :QUUX-TIME) 221
 (7F50445ADA00) : 24 (FUNCALL #'#<(:INTERNAL CCL::WITH-COMPILATION-UNIT-BODY CCL::LOAD-FROM-STREAM)>) 765
 (7F50445ADA90) : 25 (CALL-WITH-COMPILATION-UNIT #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL CCL::WITH-COMPILATION-UNIT-BODY CCL::LOAD-FROM-STREAM) #x7F504561C14F> :OVERRIDE NIL) 197
 (7F50445ADAD8) : 26 (LOAD-FROM-STREAM #<BASIC-FILE-CHARACTER-INPUT-STREAM ("/home/tunes/bug/ccl-coverage.lisp"/4 ISO-8859-1) #x3020006C227D> NIL) 389
 (7F50445ADB18) : 27 (%LOAD #P"/home/tunes/bug/ccl-coverage.lisp" NIL NIL :ERROR :DEFAULT) 4781
 (7F50445ADC68) : 28 (LOAD "/home/tunes/bug/ccl-coverage.lisp" :VERBOSE NIL :PRINT NIL :IF-DOES-NOT-EXIST :ERROR :EXTERNAL-FORMAT :DEFAULT) 1013
 (7F50445ADD00) : 29 (FUNCALL #'#<(:INTERNAL CCL::LOAD-FILE CCL::STARTUP-CCL)> "/home/tunes/bug/ccl-coverage.lisp") 493
 (7F50445ADD48) : 30 (STARTUP-CCL ("home:ccl-init" "home:\\.ccl-init")) 1717
 (7F50445ADDB8) : 31 (FUNCALL #'#<(:INTERNAL (CCL:TOPLEVEL-FUNCTION (CCL::LISP-DEVELOPMENT-SYSTEM T)))>) 77
 (7F50445ADDD8) : 32 (FUNCALL #'#<(:INTERNAL CCL::MAKE-MCL-LISTENER-PROCESS)>) 645
 (7F50445ADE70) : 33 (RUN-PROCESS-INITIAL-FORM #<TTY-LISTENER listener(1) [Active] #x3020006BD95D> (#<CCL:COMPILED-LEXICAL-CLOSURE # #x3020006BD48F>)) 717
 (7F50445ADF08) : 34 (FUNCALL #'#<(:INTERNAL (CCL::%PROCESS-PRESET-INTERNAL (CCL:PROCESS)))> #<TTY-LISTENER listener(1) [Active] #x3020006BD95D> (#<CCL:COMPILED-LEXICAL-CLOSURE # #x3020006BD48F>)) 549
 (7F50445ADF98) : 35 (FUNCALL #'#<(:INTERNAL CCL::THREAD-MAKE-STARTUP-FUNCTION)>) 301
1 > (ccl:quit)

Xref: ITA bug 117014

I haven't been able to reduce that to a small runnable example yet, but when we compile our application with (ccl::snap-reader-methods :known-sealed-world t)

If we subsequently re-define a class, even identically, some existing methods using that class will fail with an "Invalid memory operation". That's with 1.8-r15359 LinuxX8664. Before the patch from http://trac.clozure.com/ccl/changeset/14968 was used, it was a plain crash.

Can CCL be patched so that any class-redefinition after snap-reader-methods would invalidate the snapped reader methods, and possibly issue a warning or continuable error (since a promise was broken)?

Xref: ITA bug 105557