guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 01/01: Don't serialize uninterned symbols


From: Andy Wingo
Subject: [Guile-commits] 01/01: Don't serialize uninterned symbols
Date: Thu, 23 Jun 2016 13:46:35 +0000 (UTC)

wingo pushed a commit to branch master
in repository guile.

commit 1d72d469517ca858736bfc227d8382bfb1d84b21
Author: Andy Wingo <address@hidden>
Date:   Thu Jun 23 15:45:53 2016 +0200

    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.
---
 module/system/vm/assembler.scm |    2 ++
 test-suite/tests/rtl.test      |   10 ++++++++++
 2 files changed, 12 insertions(+)

diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 9fc5349..20a652c 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 57047a2..316f455 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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]