diff options
author | Andy Wingo <wingo@pobox.com> | 2016-06-23 15:45:53 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-06-23 15:45:53 +0200 |
commit | 1d72d469517ca858736bfc227d8382bfb1d84b21 (patch) | |
tree | 8b74b1c852ab3f84da5ab0cb5f9e831eae0029cb | |
parent | 2c8ea5a008959ffba629694942d75887dc14a869 (diff) | |
download | guile-1d72d469517ca858736bfc227d8382bfb1d84b21.tar.gz |
Don't serialize uninterned symbols
* module/system/vm/assembler.scm (intern-constant): Don't serialize
uninterned symbols.
* test-suite/tests/rtl.test ("bad constants"): Add a test.
-rw-r--r-- | module/system/vm/assembler.scm | 2 | ||||
-rw-r--r-- | test-suite/tests/rtl.test | 10 |
2 files changed, 12 insertions, 0 deletions
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 9fc5349b7..20a652c66 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -1034,6 +1034,8 @@ table, its existing label is used directly." `((static-patch! ,label 1 ,(static-procedure-code obj)))) ((cache-cell? 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))) (string->symbol 1 1) (static-set! 1 ,label 0))) diff --git a/test-suite/tests/rtl.test b/test-suite/tests/rtl.test index 57047a2fb..316f4557c 100644 --- a/test-suite/tests/rtl.test +++ b/test-suite/tests/rtl.test @@ -77,6 +77,16 @@ a procedure." ;; 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" (assert-equal 42 (((assemble-program `((begin-program foo |