#619 Case-sensitive structs miscompiled? [suggested fix]

lisp error
open
Bruno Haible
clisp (525)
5
2012-03-06
2011-11-03
Michael Kappert
No

It seems that keywords are stored incorrectly in the fasl for case-sensitive struct literals:

$ cat struct-case.cl
(defpackage "STORE" (:modern t))
(in-package store)

(defstruct book title author)

(defmacro defbook-expand (title author)
(make-book :title title :author author))

(defvar *et-book* (defbook-expand "aTitle" "anAuthor"))
......
cs-user> (compile-file "/home/michael/Projects/scratch/struct-case.cl")
;; Compiling file /home/michael/Projects/scratch/struct-case.cl ...
;; Wrote file /home/michael/Projects/scratch/struct-case.fas
0 errors, 0 warnings
#P"/home/michael/Projects/scratch/struct-case.fas"
nil
nil
cs-user> (load *)
;; Loading file /home/michael/Projects/scratch/struct-case.fas ...
; Evaluation aborted on #<system::simple-keyword-error #x0003348AA920>.
cs-user>

The struct literal appears in the fasl as
S(|STORE|::|book| :|title| "aTitle" :|author| "anAuthor")

Discussion

  • Now it seems more like a bug in the print-object method for structs:
    cs-user> (defstruct foo bar)
    foo
    cs-user> (let ((*print-readably* nil)) (read-from-string (format nil "~s" #s(foo :bar "bar"))))
    #S(foo :bar "bar")
    18
    cs-user> (let ((*print-readably* t)) (read-from-string (format nil "~s" #s(foo :bar "bar"))))
    ; Evaluation aborted on #<system::simple-keyword-error #x0003348EB220>.
    cs-user> (let ((*print-readably* t)) (read-from-string (format nil "~s" #s(foo :BAR "bar"))))
    ; Evaluation aborted on #<system::simple-keyword-error #x0003348EB240>.

     
    • summary: Case-sensitive structs miscompiled? --> Case-sensitive structs miscompiled? [suggested fix]
     
  • This is probably much too crude, but it fixes the problem for me: I think keywords should always be printed in upppercase in pr_structure_default. I could see no regressions in make check (tested only on Ubuntu).

    diff -r 8f5a8b96a72d src/io.d
    --- a/src/io.d Mon Oct 17 14:59:11 2011 +0300
    +++ b/src/io.d Mon Nov 07 21:48:12 2011 +0100
    @@ -8409,7 +8409,7 @@
    { /* Print (symbol-name (clos:slot-definition-name slot)): */
    var object obj = TheSlotDefinition(*slot_)->slotdef_name;
    if (!symbolp(obj)) goto bad_clas;
    - pr_like_symbol(stream_,Symbol_name(obj)); /* print symbolname of component */
    + pr_symbol_part(stream_,Symbol_name(obj),false,false); /* print symbolname of component */
    }
    JUSTIFY_SPACE;
    JUSTIFY_LAST(true);

     
    • labels: --> clisp
    • milestone: --> lisp error
     
    • assigned_to: nobody --> haible