mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00
Code Activity

Don't serialize uninterned symbols

Browse source 
* module/system/vm/assembler.scm (intern-constant): Don't serialize
  uninterned symbols.
* test-suite/tests/rtl.test ("bad constants"): Add a test.
This commit is contained in:
Andy Wingo 2016-06-23 15:45:53 +02:00
parent 2c8ea5a008
commit 1d72d46951
2 changed files with 12 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

2
module/system/vm/assembler.scm
View file

@ -1034,6 +1034,8 @@ table, its existing label is used directly."
`((static-patch! ,label 1 ,(static-procedure-code obj)))) `((static-patch! ,label 1 ,(static-procedure-code obj))))
((cache-cell? obj) '()) ((cache-cell? obj) '())
((symbol? obj) ((symbol? obj)
(unless (symbol-interned? obj)
(error "uninterned symbol cannot be saved to object file" obj))
`((make-non-immediate 1 ,(recur (symbol->string obj))) `((make-non-immediate 1 ,(recur (symbol->string obj)))
(string->symbol 1 1) (string->symbol 1 1)
(static-set! 1 ,label 0))) (static-set! 1 ,label 0)))

10
test-suite/tests/rtl.test
View file

@ -77,6 +77,16 @@ a procedure."
;; FIXME: Add more tests for arrays (uniform and otherwise) ;; FIXME: Add more tests for arrays (uniform and otherwise)
)) ))
(define-syntax-rule (assert-bad-constants val ...)
(begin
(pass-if-exception (object->string val) exception:miscellaneous-error
(return-constant val))
...))
(with-test-prefix "bad constants"
(assert-bad-constants (make-symbol "foo")
(lambda () 100)))
(with-test-prefix "static procedure" (with-test-prefix "static procedure"
(assert-equal 42 (assert-equal 42
(((assemble-program `((begin-program foo (((assemble-program `((begin-program foo