Fix infinite loop when compiling a word containing a tuple literal with circular...

diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor
index 2776ed914f44ee120eed9c705d74d48399d620b7..4d4b22218ded24298154318b4bf04084589abcad 100644 (file)
--- a/basis/compiler/tree/propagation/info/info.factor
+++ b/basis/compiler/tree/propagation/info/info.factor
@@ -59,21 +59,18 @@ CONSTANT: object-info T{ value-info f object full-interval }
 
 : <value-info> ( -- info ) \ value-info new ;
 
-: read-only-slots ( values class -- slots )
-    all-slots
-    [ read-only>> [ drop f ] unless ] 2map
-    f prefix ;
-
 DEFER: <literal-info>
 
+: tuple-slot-infos ( tuple -- slots )
+    [ tuple-slots ] [ class all-slots ] bi
+    [ read-only>> [ <literal-info> ] [ drop f ] if ] 2map
+    f prefix ;
+
 : init-literal-info ( info -- info )
     dup literal>> class >>class
     dup literal>> dup real? [ [a,a] >>interval ] [
         [ [-inf,inf] >>interval ] dip
-        dup tuple? [
-            [ tuple-slots [ <literal-info> ] map ] [ class ] bi
-            read-only-slots >>slots
-        ] [ drop ] if
+        dup tuple? [ tuple-slot-infos >>slots ] [ drop ] if
     ] if ; inline
 
 : init-value-info ( info -- info )

diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index ed8d2983b5446e7facd84f8d9d9a5ec94c6dd443..eba41dbfdf89447add34b20b193156836c49afa6 100644 (file)
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -9,7 +9,7 @@ compiler.tree.propagation.info compiler.tree.def-use
 compiler.tree.debugger compiler.tree.checker
 slots.private words hashtables classes assocs locals
 specialized-arrays.double system sorting math.libm
-math.intervals ;
+math.intervals quotations ;
 IN: compiler.tree.propagation.tests
 
 [ V{ } ] [ [ ] final-classes ] unit-test
@@ -686,3 +686,8 @@ TUPLE: littledan-2 { from read-only } { to read-only } ;
 [ V{ 0 } ] [ [ { } length ] final-literals ] unit-test
 
 [ V{ 1 } ] [ [ { } length 1+ f <array> length ] final-literals ] unit-test
+
+! Mutable tuples with circularity should not cause problems
+TUPLE: circle me ;
+
+[ ] [ circle new dup >>me 1quotation final-info drop ] unit-test
\ No newline at end of file

diff --git a/basis/compiler/tree/propagation/slots/slots.factor b/basis/compiler/tree/propagation/slots/slots.factor
index 89c2bada8b24c2e97708f5bac0d64a7f508709f8..86114772f752a4e185881d349a8bae89637dc0fd 100644 (file)
--- a/basis/compiler/tree/propagation/slots/slots.factor
+++ b/basis/compiler/tree/propagation/slots/slots.factor
@@ -30,8 +30,13 @@ UNION: fixed-length-sequence array byte-array string ;
     [ [ literal>> ] map ] dip prefix >tuple
     <literal-info> ;
 
+: read-only-slots ( values class -- slots )
+    all-slots
+    [ read-only>> [ value-info ] [ drop f ] if ] 2map
+    f prefix ;
+
 : (propagate-tuple-constructor) ( values class -- info )
-    [ [ value-info ] map ] dip [ read-only-slots ] keep
+    [ read-only-slots ] keep
     over rest-slice [ dup [ literal?>> ] when ] all? [
         [ rest-slice ] dip fold-<tuple-boa>
     ] [