Add a TODO test for block evals segfaulting on syntax errors.

[p5sagit/p5-mst-13.2.git] / t / op / range.t

diff --git a/t/op/range.t b/t/op/range.t
old mode 100755 (executable)
new mode 100644 (file)
index 6759f88..81f7b0f
--- a/t/op/range.t
+++ b/t/op/range.t
@@ -9,7 +9,7 @@ require 'test.pl';
 
 use Config;
 
-plan (115);
+plan (141);
 
 is(join(':',1..5), '1:2:3:4:5');
 
@@ -341,4 +341,81 @@ foreach my $ii (~0, ~0+1, ~0+(~0>>4)) {
     ok($@, 'Lower bound rejected: ' . -$ii);
 }
 
+# double/tripple magic tests
+sub TIESCALAR { bless { value => $_[1], orig => $_[1] } }
+sub STORE { $_[0]{store}++; $_[0]{value} = $_[1] }
+sub FETCH { $_[0]{fetch}++; $_[0]{value} }
+sub stores { tied($_[0])->{value} = tied($_[0])->{orig};
+             delete(tied($_[0])->{store}) || 0 }
+sub fetches { delete(tied($_[0])->{fetch}) || 0 }
+    
+tie $x, "main", 6;
+
+my @foo;
+@foo = 4 .. $x;
+is(scalar @foo, 3);
+is("@foo", "4 5 6");
+{
+  local $TODO = "test for double magic with range operator";
+  is(fetches($x), 1);
+}
+is(stores($x), 0);
+
+@foo = $x .. 8;
+is(scalar @foo, 3);
+is("@foo", "6 7 8");
+{
+  local $TODO = "test for double magic with range operator";
+  is(fetches($x), 1);
+}
+is(stores($x), 0);
+
+@foo = $x .. $x + 1;
+is(scalar @foo, 2);
+is("@foo", "6 7");
+{
+  local $TODO = "test for double magic with range operator";
+  is(fetches($x), 2);
+}
+is(stores($x), 0);
+
+@foo = ();
+for (4 .. $x) {
+  push @foo, $_;
+}
+is(scalar @foo, 3);
+is("@foo", "4 5 6");
+{
+  local $TODO = "test for double magic with range operator";
+  is(fetches($x), 1);
+}
+is(stores($x), 0);
+
+@foo = ();
+for (reverse 4 .. $x) {
+  push @foo, $_;
+}
+is(scalar @foo, 3);
+is("@foo", "6 5 4");
+{
+  local $TODO = "test for double magic with range operator";
+  is(fetches($x), 1);
+}
+is(stores($x), 0);
+
+is( ( join ' ', map { join '', map ++$_, ($x=1)..4 } 1..2 ), '2345 2345',
+    'modifiable variable num range' );
+is( ( join ' ', map { join '', map ++$_, 1..4      } 1..2 ), '2345 3456',
+    'modifiable const num range' );  # Unresolved bug RT#3105
+$s = ''; for (1..2) { for (1..4) { $s .= ++$_ } $s.=' ' if $_==1; }
+is( $s, '2345 2345','modifiable num counting loop counter' );
+
+
+is( ( join ' ', map { join '', map ++$_, ($x='a')..'d' } 1..2 ), 'bcde bcde',
+    'modifiable variable alpha range' );
+is( ( join ' ', map { join '', map ++$_, 'a'..'d'      } 1..2 ), 'bcde cdef',
+    'modifiable const alpha range' );  # Unresolved bug RT#3105
+$s = ''; for (1..2) { for ('a'..'d') { $s .= ++$_ } $s.=' ' if $_==1; }
+is( $s, 'bcde bcde','modifiable alpha counting loop counter' );
+
 # EOF