From: Björn Lindqvist <bjourne@gmail.com>
Date: Sat, 9 May 2015 23:27:43 +0000 (+0200)
Subject: memory.tests: a full test against #1289, it shouldn't crash
X-Git-Tag: unmaintained~2772
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=36bfd0f1057d8aaeeb1915e113a25ea5b54f4445

memory.tests: a full test against #1289, it shouldn't crash
---

diff --git a/core/memory/memory-tests.factor b/core/memory/memory-tests.factor
index 8b5360f3cf..0b7744549f 100644
--- a/core/memory/memory-tests.factor
+++ b/core/memory/memory-tests.factor
@@ -1,5 +1,5 @@
-USING: accessors effects kernel kernel.private math memory prettyprint
-io sequences tools.test words namespaces layouts classes
+USING: accessors byte-arrays effects kernel kernel.private math memory
+prettyprint io sequences tools.test words namespaces layouts classes
 classes.builtin arrays quotations system ;
 FROM: tools.memory => data-room code-room ;
 IN: memory.tests
@@ -91,3 +91,22 @@ SYMBOL: foo-var
 { } [
     minor-gc 100 deep-stack-minor-gc
 ] unit-test
+
+! Bug #1289
+TUPLE: tup2 a b c d ;
+
+: inner ( k -- n )
+    20 f <array> 20 f <array> assert=
+    ! Allocates a byte array so large that the next allocation will
+    ! trigger a gc.
+    drop 2097103 <byte-array> ;
+
+: outer ( -- lag )
+    9 iota [ inner ] map
+    ! D 0 is scrubbed, but if the branch calling 'inner' was
+    ! called, then both D 0 and D 1 should have been scrubbed.
+    0 9 1 tup2 boa ;
+
+{ } [
+    outer drop
+] unit-test