Mercurial > hg > xemacs-beta

annotate tests/automated/lisp-reader-tests.el @ 5937:9e308c7501d1 cygwin

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
6 years later, not sure about movemail
author Henry Thompson <ht@markup.co.uk>
date Thu, 02 Dec 2021 14:34:45 +0000
parents cc7f8a0e569a
children ee27ca517e90
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
3543
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
1 ;; Copyright (C) 2005 Martin Kuehl.
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
2
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
3 ;; Author: Martin Kuehl <martin.kuehl@gmail.com>
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
4 ;; Maintainer: Martin Kuehl <martin.kuehl@gmail.com>
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
5 ;; Created: 2005
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
6 ;; Keywords: tests
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
7
5290
e6508b64ee08 More permission consistency.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 3543
diff changeset
8 ;; This file is part of XEmacs.
3543
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
9
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3543
diff changeset
10 ;; XEmacs is free software: you can redistribute it and/or modify it
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3543
diff changeset
11 ;; under the terms of the GNU General Public License as published by the
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3543
diff changeset
12 ;; Free Software Foundation, either version 3 of the License, or (at your
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3543
diff changeset
13 ;; option) any later version.
3543
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
14
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3543
diff changeset
15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3543
diff changeset
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3543
diff changeset
17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3543
diff changeset
18 ;; for more details.
3543
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
19
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 3543
diff changeset
21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>.
3543
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
22
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
23 ;;; Synched up with: Not in FSF.
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
24
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
25 ;;; Commentary:
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
26
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
27 ;; Test the lisp reader.
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
28 ;; See test-harness.el for instructions on how to run these tests.
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
29
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
30 ;;; Raw Strings
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
31 ;;; ===========
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
32
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
33 ;; Equality to "traditional" strings
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
34 ;; ---------------------------------
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
35 (dolist (strings '((#r"xyz" "xyz") ; no backslashes
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
36 (#r"\xyz" "\\xyz") ; backslash at start
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
37 (#r"\\xyz" "\\\\xyz") ; backslashes at start
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
38 (#r"\nxyz" "\\nxyz") ; escape seq. at start
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
39 (#r"\"xyz" "\\\"xyz") ; quote at start
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
40 (#r"xy\z" "xy\\z") ; backslash in middle
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
41 (#r"xy\\z" "xy\\\\z") ; backslashes in middle
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
42 (#r"xy\nz" "xy\\nz") ; escape seq. in middle
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
43 (#r"xy\"z" "xy\\\"z") ; quote in middle
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
44 ;;(#r"xyz\" "xyz\\") ; backslash at end: error
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
45 (#r"xyz\\" "xyz\\\\") ; backslashes at end
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
46 (#r"xyz\n" "xyz\\n") ; escape seq. at end
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
47 (#r"xyz\"" "xyz\\\"") ; quote at end
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
48 (#ru"\u00ABxyz" "\u00ABxyz") ; one Unicode escape
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
49 (#rU"\U000000ABxyz" "\U000000ABxyz") ; another Unicode escape
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
50 (#rU"xyz\u00AB" "xyz\u00AB") ; one Unicode escape
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
51 ))
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
52 (Assert (apply #'string= strings)))
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
53
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
54 ;; Odd number of backslashes at the end
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
55 ;; ------------------------------------
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
56 (dolist (string '("#r\"xyz\\\"" ; `#r"abc\"': escaped delimiter
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
57 "#r\"xyz\\\\\\\"" ; `#r"abc\\\"': escaped delimiter
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
58 ))
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
59 (with-temp-buffer
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
60 (insert string)
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
61 (Check-Error end-of-file (eval-buffer))))
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
62
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
63 ;; Alternate string/regex delimiters
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
64 ;; ---------------------------------
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
65 (dolist (string '("#r/xyz/" ; Perl syntax
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
66 "#r:ix/xyz/" ; Extended Perl syntax
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
67 "#r|xyz|" ; TeX syntax
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
68 "#r[xyz]" ; (uncommon) Perl syntax
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
69 "#r<xyz>" ; Perl6 syntax?
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
70 "#r(xyz)" ; arbitrary santax
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
71 "#r{xyz}" ; arbitrary santax
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
72 "#r,xyz," ; arbitrary santax
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
73 "#r!xyz!" ; arbitrary santax
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
74 ))
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
75 (with-temp-buffer
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
76 (insert string)
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
77 (Check-Error-Message invalid-read-syntax "unrecognized raw string"
c136144fe765 [xemacs-hg @ 2006-08-04 22:55:04 by aidan]
aidan
parents:
diff changeset
78 (eval-buffer))))
5489
159face738c3 Never pass a leading + to mpz_set_string, parse_integer ().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5420
diff changeset
79
159face738c3 Never pass a leading + to mpz_set_string, parse_integer ().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5420
diff changeset
80 (when (featurep 'bignum)
159face738c3 Never pass a leading + to mpz_set_string, parse_integer ().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5420
diff changeset
81 ;; This failed, up to 20110501.
159face738c3 Never pass a leading + to mpz_set_string, parse_integer ().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5420
diff changeset
82 (Assert (eql (1+ most-positive-fixnum)
159face738c3 Never pass a leading + to mpz_set_string, parse_integer ().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5420
diff changeset
83 (read (format "+%d" (1+ most-positive-fixnum))))
159face738c3 Never pass a leading + to mpz_set_string, parse_integer ().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5420
diff changeset
84 "checking leading + is handled properly if reading a bignum")
159face738c3 Never pass a leading + to mpz_set_string, parse_integer ().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5420
diff changeset
85 ;; This never did.
159face738c3 Never pass a leading + to mpz_set_string, parse_integer ().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5420
diff changeset
86 (Assert (eql (1- most-positive-fixnum)
159face738c3 Never pass a leading + to mpz_set_string, parse_integer ().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5420
diff changeset
87 (read (format "+%d" (1- most-positive-fixnum))))
159face738c3 Never pass a leading + to mpz_set_string, parse_integer ().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5420
diff changeset
88 "checking leading + is handled properly if reading a fixnum"))
159face738c3 Never pass a leading + to mpz_set_string, parse_integer ().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5420
diff changeset
89
5560
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
90 ;; Test print-circle.
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
91 (let ((cons '#1=(1 2 3 4 5 6 . #1#))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
92 (vector #2=[1 2 3 4 5 6 #2#])
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
93 (compiled-function #3=#[(argument) "\xc2\x09\x08\"\x87"
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
94 [pi argument #3#] 3])
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
95 (char-table #4=#s(char-table :type generic :data (?\u0080 #4#)))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
96 (hash-table #5=#s(hash-table :test eql :data (a b c #5# e f)))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
97 (range-table #6=#s(range-table :type start-closed-end-open
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
98 :data ((#x00 #xff) hello
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
99 (#x100 #x1ff) #6#
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
100 (#x200 #x2ff) everyone)))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
101 (print-readably t)
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
102 (print-circle t)
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
103 deserialized-cons deserialized-vector deserialized-compiled-function
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
104 deserialized-char-table deserialized-hash-table deserialized-range-table)
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
105 (Assert (eq (nthcdr 6 cons) cons)
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
106 "checking basic recursive cons read properly")
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
107 (Assert (eq vector (aref vector (1- (length vector))))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
108 "checking basic recursive vector read properly")
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
109 (Assert (eq compiled-function
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
110 (find-if #'compiled-function-p
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
111 (compiled-function-constants compiled-function)))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
112 "checking basic recursive compiled-function read properly")
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
113 (Check-Error wrong-number-of-arguments (funcall compiled-function 3))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
114 (Assert (eq char-table (get-char-table ?\u0080 char-table))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
115 "checking basic recursive char table read properly")
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
116 (Assert (eq hash-table (gethash 'c hash-table))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
117 "checking basic recursive hash table read properly")
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
118 (Assert (eq range-table (get-range-table #x180 range-table))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
119 "checking basic recursive range table read properly")
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
120 (setf (gethash 'g hash-table) cons
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
121 (car cons) hash-table
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
122 deserialized-hash-table (read (prin1-to-string hash-table)))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
123 (Assert (not (eq deserialized-hash-table hash-table))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
124 "checking printing and reading hash-table creates a new object")
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
125 (Assert (eq deserialized-hash-table (gethash 'c deserialized-hash-table))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
126 "checking the lisp reader handles deserialized hash-table identity")
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
127 (Assert (eq deserialized-hash-table
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
128 (car (gethash 'g deserialized-hash-table)))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
129 "checking the reader handles deserialization identity, hash-table")
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
130 (setf (get-char-table ?a char-table) cons
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
131 (car cons) char-table
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
132 deserialized-char-table (read (prin1-to-string char-table)))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
133 (Assert (not (eq deserialized-char-table char-table))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
134 "checking printing and reading creates a new object")
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
135 (Assert (eq deserialized-char-table
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
136 (get-char-table ?\u0080 deserialized-char-table))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
137 "checking the lisp reader handles deserialization identity")
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
138 (Assert (eq deserialized-char-table
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
139 (car (get-char-table ?a deserialized-char-table)))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
140 "checking the lisp reader handles deserialization identity, mixed")
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
141 (put-range-table #x1000 #x1010 cons range-table)
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
142 (setf (car cons) range-table
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
143 deserialized-range-table (read (prin1-to-string range-table)))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
144 (Assert (not (eq deserialized-range-table range-table))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
145 "checking printing and reading creates a new object")
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
146 (Assert (eq deserialized-range-table
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
147 (get-range-table #x101 deserialized-range-table))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
148 "checking the lisp reader handles deserialization identity")
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
149 (Assert (eq deserialized-range-table
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
150 (car (get-range-table #x1001 deserialized-range-table)))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
151 "checking the lisp reader handles deserialization identity, mixed"))
58b38d5b32d0 Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5489
diff changeset
152
5605
cc7f8a0e569a Accept bignums unambiguously in the syntax for object labels, lread.c.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5560
diff changeset
153 (when (featurep 'bignum)
cc7f8a0e569a Accept bignums unambiguously in the syntax for object labels, lread.c.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5560
diff changeset
154 (Assert (null (list-length (read (format "#%d=(1 #1=(5) 3 4 . #%d#)"
cc7f8a0e569a Accept bignums unambiguously in the syntax for object labels, lread.c.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5560
diff changeset
155 (+ most-positive-fixnum 2)
cc7f8a0e569a Accept bignums unambiguously in the syntax for object labels, lread.c.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5560
diff changeset
156 (+ most-positive-fixnum 2)))))
cc7f8a0e569a Accept bignums unambiguously in the syntax for object labels, lread.c.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5560
diff changeset
157 "checking bignum object labels don't wrap on reading"))