diff tests/automated/lisp-tests.el @ 5241:d579d76f3dcc

Be more careful about side-effects from Lisp code, #'reduce src/ChangeLog addition: 2010-07-24 Aidan Kehoe <kehoea@parhasard.net> * lisp.h (PARSE_KEYWORDS): Always accept a nil :allow-other-keys keyword argument, as described in the ALLOW-OTHER-KEYS-NIL Common Lisp issue writeup, and as necessary for Paul Dietz' tests for #'reduce. * fns.c (mapping_interaction_error): New. (Freduce): Call mapping_interaction_error when KEY or FUNCTION have modified a string SEQUENCE such that the byte length of the string has changed, or such that the current cursor pointer doesn't point to the beginning of a character. Cf. the MAPPING-DESTRUCTIVE-INTERACTION Common Lisp issue writeup. When traversing a list, GCPRO the part of it we still have to traverse, to avoid any crashes if FUNCTION or KEY amputate it behind us and force a garbage collection. tests/ChangeLog addition: 2010-07-24 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test a couple of things #'reduce was just made more careful about.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 24 Jul 2010 15:56:57 +0100
parents 71ee43b8a74d
children 808131ba4a57
line wrap: on
line diff
--- a/tests/automated/lisp-tests.el	Tue Jul 13 10:20:22 2010 +0200
+++ b/tests/automated/lisp-tests.el	Sat Jul 24 15:56:57 2010 +0100
@@ -2341,4 +2341,37 @@
 	       (gethash hashed-bignum hashing))
 	      "checking hashing works correctly with #'eql tests and bignums"))))
 
+;; 
+(when (decode-char 'ucs #x0192)
+  (Check-Error
+   invalid-state
+   (let ((str "aaaaaaaaaaaaa")
+	 (called 0)
+	 modified)
+     (reduce #'+ str
+	     :key #'(lambda (object)
+		      (prog1
+			  object
+			(incf called) 
+			(or modified
+			    (and (> called 5)
+				 (setq modified
+				       (fill str (read #r"?\u0192")))))))))))
+
+(Assert
+ (eql 55
+      (let ((sequence '(1 2 3 4 5 6 7 8 9 10))
+	    (called 0)
+	    modified)
+	(reduce #'+
+		sequence
+		:key
+		#'(lambda (object) (prog1
+				       object
+				     (incf called)
+				     (and (eql called 5)
+					  (setcdr (nthcdr 3 sequence) nil))
+				     (garbage-collect))))))
+ "checking we can amputate lists without crashing #'reduce")
+
 ;;; end of lisp-tests.el