Commit c7bc28bf authored by Paul Eggert's avatar Paul Eggert

Don’t attempt to modify constant conses

From a patch privately suggested by Mattias Engdegård on 2020-05-11
in a followup to Bug#40671.
* admin/charsets/cp51932.awk:
* admin/charsets/eucjp-ms.awk:
Generate code that does not modify constant conses.
* doc/misc/emacs-mime.texi (Encoding Customization):
* lisp/emacs-lisp/byte-opt.el (byte-compile-side-effect-free-ops):
* lisp/frameset.el (frameset-persistent-filter-alist):
* lisp/gnus/gnus-sum.el (gnus-article-mode-line-format-alist):
Use append instead of nconc.
* lisp/language/japanese.el (japanese-ucs-cp932-to-jis-map)
(jisx0213-to-unicode):
Use mapcar instead of mapc.
* lisp/language/lao-util.el (lao-transcription-consonant-alist)
(lao-transcription-vowel-alist):
* lisp/language/tibetan.el (tibetan-subjoined-transcription-alist):
Use copy-sequence.
* test/src/fns-tests.el (fns-tests-nreverse):
(fns-tests-sort, fns-tests-collate-sort)
(fns-tests-string-version-lessp, fns-tests-mapcan):
Use copy-sequence, vector, and list.
parent a6ebca21
Pipeline #5587 passed with stage
in 56 minutes and 47 seconds
......@@ -43,13 +43,14 @@ BEGIN {
END {
print ")))";
print " (mapc #'(lambda (x)";
print " (setcar x (decode-char 'japanese-jisx0208 (car x))))";
print " map)";
print " (setq map (mapcar (lambda (x)";
print " (cons (decode-char 'japanese-jisx0208 (car x))";
print " (cdr x)))";
print " map))";
print " (define-translation-table 'cp51932-decode map)";
print " (mapc #'(lambda (x)";
print " (let ((tmp (car x)))";
print " (setcar x (cdr x)) (setcdr x tmp)))";
print " (mapc (lambda (x)";
print " (let ((tmp (car x)))";
print " (setcar x (cdr x)) (setcdr x tmp)))";
print " map)";
print " (define-translation-table 'cp51932-encode map))";
print "";
......
......@@ -93,15 +93,17 @@ function write_entry (unicode) {
END {
print ")))";
print " (mapc #'(lambda (x)";
print " (setq map";
print " (mapcar";
print " (lambda (x)";
print " (let ((code (logand (car x) #x7F7F)))";
print " (if (integerp (cdr x))";
print " (setcar x (decode-char 'japanese-jisx0208 code))";
print " (setcar x (decode-char 'japanese-jisx0212 code))";
print " (setcdr x (cadr x)))))";
print " map)";
print " (cons (decode-char 'japanese-jisx0208 code) (cdr x))";
print " (cons (decode-char 'japanese-jisx0212 code)"
print " (cadr x)))))";
print " map))";
print " (define-translation-table 'eucjp-ms-decode map)";
print " (mapc #'(lambda (x)";
print " (mapc (lambda (x)";
print " (let ((tmp (car x)))";
print " (setcar x (cdr x)) (setcdr x tmp)))";
print " map)";
......
......@@ -917,7 +917,7 @@ Here's an example:
@lisp
(add-to-list 'gnus-newsgroup-variables 'mm-coding-system-priorities)
(setq gnus-parameters
(nconc
(append
;; Some charsets are just examples!
'(("^cn\\." ;; Chinese
(mm-coding-system-priorities
......
......@@ -1509,7 +1509,7 @@
byte-current-buffer byte-stack-ref))
(defconst byte-compile-side-effect-free-ops
(nconc
(append
'(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
......
......@@ -396,17 +396,17 @@ Properties can be set with
;; or, if you're only changing a few items,
;;
;; (defvar my-filter-alist
;; (nconc '((my-param1 . :never)
;; (my-param2 . my-filtering-function))
;; frameset-filter-alist)
;; (append '((my-param1 . :never)
;; (my-param2 . my-filtering-function))
;; frameset-filter-alist)
;; "My brief customized parameter filter alist.")
;;
;; and pass it to the FILTER arg of the save/restore functions,
;; ALWAYS taking care of not modifying the original lists; if you're
;; going to do any modifying of my-filter-alist, please use
;;
;; (nconc '((my-param1 . :never) ...)
;; (copy-sequence frameset-filter-alist))
;; (append '((my-param1 . :never) ...)
;; (copy-sequence frameset-filter-alist))
;;
;; One thing you shouldn't forget is that they are alists, so searching
;; in them is sequential. If you just want to change the default of
......@@ -445,7 +445,7 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
;;;###autoload
(defvar frameset-persistent-filter-alist
(nconc
(append
'((background-color . frameset-filter-sanitize-color)
(buffer-list . :never)
(buffer-predicate . :never)
......
......@@ -1501,9 +1501,9 @@ the type of the variable (string, integer, character, etc).")
;; This is here rather than in gnus-art for compilation reasons.
(defvar gnus-article-mode-line-format-alist
(nconc '((?w (gnus-article-wash-status) ?s)
(?m (gnus-article-mime-part-status) ?s))
gnus-summary-mode-line-format-alist))
(append '((?w (gnus-article-wash-status) ?s)
(?m (gnus-article-mime-part-status) ?s))
gnus-summary-mode-line-format-alist))
(defvar gnus-last-search-regexp nil
"Default regexp for article search command.")
......
......@@ -82,9 +82,7 @@
(#x00A6 . #xFFE4) ; BROKEN LINE FULLWIDTH BROKEN LINE
)))
(define-translation-table 'japanese-ucs-jis-to-cp932-map map)
(mapc #'(lambda (x) (let ((tmp (car x)))
(setcar x (cdr x)) (setcdr x tmp)))
map)
(setq map (mapcar (lambda (x) (cons (cdr x) (car x))) map))
(define-translation-table 'japanese-ucs-cp932-to-jis-map map))
;; U+2014 (EM DASH) vs U+2015 (HORIZONTAL BAR)
......@@ -241,8 +239,10 @@ eucJP-ms is defined in <http://www.opengroup.or.jp/jvc/cde/appendix.html>."
(#x2b65 . [#x02E9 #x02E5])
(#x2b66 . [#x02E5 #x02E9])))
table)
(dolist (elt map)
(setcar elt (decode-char 'japanese-jisx0213-1 (car elt))))
(setq map
(mapcar (lambda (x) (cons (decode-char 'japanese-jisx0213-1 (car x))
(cdr x)))
map))
(setq table (make-translation-table-from-alist map))
(define-translation-table 'jisx0213-to-unicode table)
(define-translation-table 'unicode-to-jisx0213
......
......@@ -183,7 +183,9 @@
;; Semi-vowel-sign-lo and lower vowels are put under the letter.
(defconst lao-transcription-consonant-alist
(sort '(;; single consonants
(sort
(copy-sequence
'(;; single consonants
("k" . "ກ")
("kh" . "ຂ")
("qh" . "ຄ")
......@@ -223,14 +225,16 @@
("hy" . ["ຫຍ"])
("hn" . ["ຫນ"])
("hm" . ["ຫມ"])
)
(function (lambda (x y) (> (length (car x)) (length (car y)))))))
))
(lambda (x y) (> (length (car x)) (length (car y))))))
(defconst lao-transcription-semi-vowel-alist
'(("r" . "ຼ")))
(defconst lao-transcription-vowel-alist
(sort '(("a" . "ະ")
(sort
(copy-sequence
'(("a" . "ະ")
("ar" . "າ")
("i" . "ິ")
("ii" . "ີ")
......@@ -257,8 +261,8 @@
("ai" . "ໄ")
("ei" . "ໃ")
("ao" . ["ເົາ"])
("aM" . "ຳ"))
(function (lambda (x y) (> (length (car x)) (length (car y)))))))
("aM" . "ຳ")))
(lambda (x y) (> (length (car x)) (length (car y))))))
;; Maa-sakod is put at the tail.
(defconst lao-transcription-maa-sakod-alist
......
......@@ -326,7 +326,9 @@
(defconst tibetan-subjoined-transcription-alist
(sort '(("+k" . "ྐ")
(sort
(copy-sequence
'(("+k" . "ྐ")
("+kh" . "ྑ")
("+g" . "ྒ")
("+gh" . "ྒྷ")
......@@ -371,8 +373,8 @@
("+W" . "ྺ") ;; fixed form subscribed WA
("+Y" . "ྻ") ;; fixed form subscribed YA
("+R" . "ྼ") ;; fixed form subscribed RA
)
(lambda (x y) (> (length (car x)) (length (car y))))))
))
(lambda (x y) (> (length (car x)) (length (car y))))))
;;;
;;; alist for Tibetan base consonant <-> subjoined consonant conversion.
......
......@@ -49,21 +49,21 @@
(should-error (nreverse))
(should-error (nreverse 1))
(should-error (nreverse (make-char-table 'foo)))
(should (equal (nreverse "xyzzy") "yzzyx"))
(let ((A []))
(should (equal (nreverse (copy-sequence "xyzzy")) "yzzyx"))
(let ((A (vector)))
(nreverse A)
(should (equal A [])))
(let ((A [0]))
(let ((A (vector 0)))
(nreverse A)
(should (equal A [0])))
(let ((A [1 2 3 4]))
(let ((A (vector 1 2 3 4)))
(nreverse A)
(should (equal A [4 3 2 1])))
(let ((A [1 2 3 4]))
(let ((A (vector 1 2 3 4)))
(nreverse A)
(nreverse A)
(should (equal A [1 2 3 4])))
(let* ((A [1 2 3 4])
(let* ((A (vector 1 2 3 4))
(B (nreverse (nreverse A))))
(should (equal A B))))
......@@ -146,13 +146,13 @@
;; Invalid UTF-8 sequences shall be indicated. How to create such strings?
(ert-deftest fns-tests-sort ()
(should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
(should (equal (sort (list 9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
'(-1 2 3 4 5 5 7 8 9)))
(should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
(should (equal (sort (list 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
'(9 8 7 5 5 4 3 2 -1)))
(should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (< x y)))
(should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
[-1 2 3 4 5 5 7 8 9]))
(should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (> x y)))
(should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
[9 8 7 5 5 4 3 2 -1]))
(should (equal
(sort
......@@ -172,7 +172,7 @@
;; Punctuation and whitespace characters are relevant for POSIX.
(should
(equal
(sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
(sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
(lambda (a b) (string-collate-lessp a b "POSIX")))
'("1 1" "1 2" "1.1" "1.2" "11" "12")))
;; Punctuation and whitespace characters are not taken into account
......@@ -180,7 +180,7 @@
(when (eq system-type 'windows-nt)
(should
(equal
(sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
(sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
(lambda (a b)
(let ((w32-collate-ignore-punctuation t))
(string-collate-lessp
......@@ -190,7 +190,7 @@
;; Diacritics are different letters for POSIX, they sort lexicographical.
(should
(equal
(sort '("Ævar" "Agustín" "Adrian" "Eli")
(sort (list "Ævar" "Agustín" "Adrian" "Eli")
(lambda (a b) (string-collate-lessp a b "POSIX")))
'("Adrian" "Agustín" "Eli" "Ævar")))
;; Diacritics are sorted between similar letters for other locales,
......@@ -198,7 +198,7 @@
(when (eq system-type 'windows-nt)
(should
(equal
(sort '("Ævar" "Agustín" "Adrian" "Eli")
(sort (list "Ævar" "Agustín" "Adrian" "Eli")
(lambda (a b)
(let ((w32-collate-ignore-punctuation t))
(string-collate-lessp
......@@ -212,7 +212,7 @@
(should (not (string-version-lessp "foo20000.png" "foo12.png")))
(should (string-version-lessp "foo.png" "foo2.png"))
(should (not (string-version-lessp "foo2.png" "foo.png")))
(should (equal (sort '("foo12.png" "foo2.png" "foo1.png")
(should (equal (sort (list "foo12.png" "foo2.png" "foo1.png")
'string-version-lessp)
'("foo1.png" "foo2.png" "foo12.png")))
(should (string-version-lessp "foo2" "foo1234"))
......@@ -432,9 +432,9 @@
(should-error (mapcan))
(should-error (mapcan #'identity))
(should-error (mapcan #'identity (make-char-table 'foo)))
(should (equal (mapcan #'list '(1 2 3)) '(1 2 3)))
(should (equal (mapcan #'list (list 1 2 3)) '(1 2 3)))
;; `mapcan' is destructive
(let ((data '((foo) (bar))))
(let ((data (list (list 'foo) (list 'bar))))
(should (equal (mapcan #'identity data) '(foo bar)))
(should (equal data '((foo bar) (bar))))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment