changeset 4608:1e3cf11fa27d

Make #$ truly read-only for Lisp; check this in the test suite. lisp/ChangeLog addition: 2009-02-10 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el : Check that #$ is not modifiable from Lisp, and that load-file-name is modifiable from Lisp. src/ChangeLog addition: 2009-02-10 Aidan Kehoe <kehoea@parhasard.net> * lread.c (Fload_internal): Make load-file-name-internal readonly for Lisp code; make load-file-name a modifiable copy. (init_lread): Initialised Vload_file_name_internal, Vload_file_name to nil on each post-dump start.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 10 Feb 2009 16:07:31 +0000
parents 517f6887fbc0
children 33b8c874b2c8
files src/ChangeLog src/lread.c tests/ChangeLog tests/automated/lisp-tests.el
diffstat 4 files changed, 58 insertions(+), 1 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog	Sun Feb 08 18:45:22 2009 +0000
+++ b/src/ChangeLog	Tue Feb 10 16:07:31 2009 +0000
@@ -1,3 +1,12 @@
+2009-02-10  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* lread.c (Fload_internal): 
+	Make load-file-name-internal readonly for Lisp code; make
+	load-file-name a modifiable copy. 
+	(init_lread): 
+	Initialised Vload_file_name_internal, Vload_file_name to nil on
+	each post-dump start.
+
 2009-02-02  Stephen J. Turnbull  <stephen@xemacs.org>
 
 	* frame-x.c (x_init_frame_2): Update comment per new info from HT.
--- a/src/lread.c	Sun Feb 08 18:45:22 2009 +0000
+++ b/src/lread.c	Tue Feb 10 16:07:31 2009 +0000
@@ -711,6 +711,8 @@
 
   PRINT_LOADING_MESSAGE ("");
 
+  LISP_READONLY (found) = 1;
+
   {
     /* Lisp_Object's must be malloc'ed, not stack-allocated */
     Lisp_Object lispstream = Qnil;
@@ -738,7 +740,8 @@
     record_unwind_protect (load_force_doc_string_unwind,
 			   Vload_force_doc_string_list);
     Vload_force_doc_string_list = Qnil;
-    internal_bind_lisp_object (&Vload_file_name, found);
+    /* load-file-name is not read-only to Lisp. */
+    internal_bind_lisp_object (&Vload_file_name, Fcopy_sequence(found));
 #ifdef I18N3
     /* set it to nil; a call to #'domain will set it. */
     internal_bind_lisp_object (&Vfile_domain, Qnil);
@@ -3266,6 +3269,9 @@
     Vread_buffer_stream = make_resizing_buffer_output_stream ();
 
   Vload_force_doc_string_list = Qnil;
+
+  Vload_file_name_internal = Qnil;
+  Vload_file_name = Qnil;
 }
 
 void
--- a/tests/ChangeLog	Sun Feb 08 18:45:22 2009 +0000
+++ b/tests/ChangeLog	Tue Feb 10 16:07:31 2009 +0000
@@ -1,3 +1,9 @@
+2009-02-10  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el : 
+	Check that #$ is not modifiable from Lisp, and that load-file-name
+	is modifiable from Lisp.
+
 2009-02-07  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/query-coding-tests.el: 
--- a/tests/automated/lisp-tests.el	Sun Feb 08 18:45:22 2009 +0000
+++ b/tests/automated/lisp-tests.el	Tue Feb 10 16:07:31 2009 +0000
@@ -1334,3 +1334,39 @@
                              (prin1-to-string char-table-with-symbol)))
           "Check that char table elements are quoted correctly when printing"))
 
+
+(let ((test-file-name
+       (make-temp-file (expand-file-name "sR4KDwU" (temp-directory))
+		       nil ".el")))
+  (find-file test-file-name)
+  (erase-buffer)
+  (insert 
+       "\
+;; Lisp should not be able to modify #$, which is
+;; Vload_file_name_internal of lread.c.
+(Check-Error setting-constant (aset #$ 0 ?\\ ))
+
+;; But modifying load-file-name should work:
+(let ((new-char ?\\ )
+      old-char)
+  (setq old-char (aref load-file-name 0))
+  (if (= new-char old-char)
+      (setq new-char ?/))
+  (aset load-file-name 0 new-char)
+  (Assert (= new-char (aref load-file-name 0))
+	  \"Check that we can modify the string value of load-file-name\"))
+
+(let* ((new-load-file-name \"hi there\")
+       (load-file-name new-load-file-name))
+  (Assert (eq new-load-file-name load-file-name)
+	  \"Checking that we can bind load-file-name successfully.\"))
+
+")
+   (write-region (point-min) (point-max) test-file-name nil 'quiet)
+   (set-buffer-modified-p nil)
+   (kill-buffer nil)
+   (load test-file-name nil t nil)
+   (delete-file test-file-name))
+
+
+