scratch/comp-static-data dfee4b1464f: Add tests for testing immutability of native comp-ed Lisp literals.

[Vibhav Pant]

branch: scratch/comp-static-data
commit dfee4b1464f0b8ce4907f23b9eb91ed4d83a0e9f
Author: Vibhav Pant <vibhavp@gmail.com>
Commit: Vibhav Pant <vibhavp@gmail.com>

    Add tests for testing immutability of native comp-ed Lisp literals.
    
    * src/comp-test-funcs.el (comp-test-literal-list,
    comp-test-literal-vector, comp-test-literal-record,
    comp-test-literal-string): New variables.
    (comp-test-modify-const-list): New function.
    
    * test/src/comp-tests.el (comp-tests-static-lisp-consts): New
    test, try to destructively modify statically compiled self evaluating
    Lisp data and make sure it triggers a error with the correct string
    and object.
---
 test/src/comp-resources/comp-test-funcs.el |  8 ++++++++
 test/src/comp-tests.el                     | 28 ++++++++++++++++++++++++++++
 2 files changed, 36 insertions(+)

diff --git a/test/src/comp-resources/comp-test-funcs.el 
b/test/src/comp-resources/comp-test-funcs.el
index fff881dd595..f0783c1b86a 100644
--- a/test/src/comp-resources/comp-test-funcs.el
+++ b/test/src/comp-resources/comp-test-funcs.el
@@ -708,6 +708,14 @@
   (when (= x 1.0e+INF)
     x))
 
+(defvar comp-test-literal-list '(1 2 3 4))
+(defvar comp-test-literal-vector [1 2 3 4])
+(defvar comp-test-literal-record #s(type 1 2 3 4))
+(defvar comp-test-literal-string "Foo")
+
+(defun comp-test-modify-const-list ()
+  (setcar comp-test-literal-list nil))
+
 (provide 'comp-test-funcs)
 
 ;;; comp-test-funcs.el ends here
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 926ba27e563..a4942be107f 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -760,6 +760,34 @@ 
https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html.";
                  '(1 2))))
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for statically compiled literals. ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(when (featurep 'comp--static-lisp-consts)
+  (comp-deftest static-lisp-consts ()
+   "Verify the compilation of self evaluating forms."
+   (let ((cases `((
+                   (setcar comp-test-literal-list nil)
+                   . ,comp-test-literal-list)
+                 ((aset comp-test-literal-vector 2 nil)
+                  . ,comp-test-literal-vector)
+                 ((aset comp-test-literal-record 2 nil)
+                  . ,comp-test-literal-record)
+                 ((aset comp-test-literal-string 1 ?c)
+                  . ,comp-test-literal-string)
+                 ((comp-test-modify-const-list)
+                  . ,comp-test-literal-list))))
+     (dolist (pair cases)
+       (let* ((form (car pair))
+             (obj (cdr pair))
+             (desc (should-error (eval form) :type 'error)))
+         (should (= (length desc) 3))
+         (should (eq (nth 0 desc) 'error))
+         (should (equal (nth 1 desc) "Attempt to modify read-only object"))
+         (should (eq (nth 2 desc) obj)))))))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Middle-end specific tests. ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;