mirrors: delete-at and clear-assoc are an error, fix #1757

M\ mirror delete-at and M\ mirror clear-assoc
	have been made to throw a new
	mirror-slot-removal error, because
	it doesn't make sense to remove a
	tuple slot, and this behaviour should
	not have been relied on.

diff --git a/basis/mirrors/mirrors-tests.factor b/basis/mirrors/mirrors-tests.factor
index 3bb9a590abea717f74f59ff9a9fe21d6bdee6200..0a2faee7b0e167e8ca289b8dcb726895f437f462 100644 (file)
--- a/basis/mirrors/mirrors-tests.factor
+++ b/basis/mirrors/mirrors-tests.factor
@@ -49,9 +49,8 @@ TUPLE: color
 { green integer }
 { blue integer } ;
 
-{ T{ color f 0 0 0 } } [
-    1 2 3 color boa [ <mirror> clear-assoc ] keep
-] unit-test
+[ \ + make-mirror clear-assoc ] must-fail
+[ \ + make-mirror [ "name" ] dip delete-at ] must-fail
 
 ! Test reshaping with a mirror
 1 2 3 color boa <mirror> "mirror" set

diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor
index 4ac2dc6689d3147025eff08366ed02bc437a39de..451abcfb3a7634a13c2bd7065965c82530ba1a65 100644 (file)
--- a/basis/mirrors/mirrors.factor
+++ b/basis/mirrors/mirrors.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs classes classes.tuple classes.tuple.private
 combinators fry hash-sets hashtables kernel math sequences sets slots
-slots.private ;
+slots.private summary present formatting ;
 IN: mirrors
 
 TUPLE: mirror { object read-only } ;
@@ -30,13 +30,16 @@ M: mirror set-at ( val key mirror -- )
     [ object-slots slot-named check-set-slot ] [ object>> ] bi
     swap set-slot ;
 
+ERROR: mirror-slot-removal slots mirror method ;
+
 M: mirror delete-at ( key mirror -- )
-    [ f ] 2dip set-at ;
+    \ delete-at mirror-slot-removal ;
 
 M: mirror clear-assoc ( mirror -- )
-    [ object-slots ] [ object>> ] bi '[
-        [ initial>> ] [ offset>> _ swap set-slot ] bi
-    ] each ;
+    [ object-slots ] keep \ clear-assoc mirror-slot-removal ;
+
+M: mirror-slot-removal summary
+    drop "Slots cannot be removed from a tuple or a mirror of it" ;
 
 M: mirror >alist ( mirror -- alist )
     [ object-slots ] [ object>> ] bi '[