Permalink
Browse files

[gsoc_spectest] t/data_types/* -> t/spec/S02-builtin_data_types/

git-svn-id: http://svn.pugscode.org/pugs@20997 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
1 parent a20ac7d commit 0ca4c116576be1e2d5484458258c315b0243b118 Auzon committed Jun 24, 2008
@@ -0,0 +1,108 @@
+use v6;
+
+use Test;
+
+=kwid
+
+Block tests
+
+This covers anonymous blocks and subs, as well as pointy blocks
+(with and without args) and bare blocks.
+
+L<S06/"Blocks">
+L<S04/"The Relationship of Blocks and Declarations">
+
+=cut
+
+plan 32;
+
+# L<S06/"Anonymous subroutines">
+# anon blocks
+my $anon_sub = sub { 1 };
+isa_ok($anon_sub, 'Sub');
+is($anon_sub(), 1, 'sub { } works');
+
+my $anon_sub_w_arg = sub ($arg) { 1 + $arg };
+isa_ok($anon_sub_w_arg, 'Sub');
+is($anon_sub_w_arg(3), 4, 'sub ($arg) {} works');
+
+# L<S06/"Blocks">
+# anon blocks
+my $anon_block = { 1 };
+isa_ok($anon_block, 'Block');
+is($anon_block(), 1, '{} <anon block> works');
+
+# L<S06/""Pointy blocks"">
+# pointy subs
+my $pointy_block = -> { 1 };
+isa_ok($pointy_block, 'Block');
+is($pointy_block(), 1, '-> {} <"pointy" block> works');
+
+my $pointy_block_w_arg = -> $arg { 1 + $arg };
+isa_ok($pointy_block_w_arg, 'Block');
+is($pointy_block_w_arg(3), 4, '-> $arg {} <"pointy" block w/args> works');
+
+my $pointy_block_w_multiple_args = -> $arg1, $arg2 { $arg1 + $arg2 };
+isa_ok($pointy_block_w_multiple_args, 'Block');
+is($pointy_block_w_multiple_args(3, 4), 7, '-> $arg1, $arg2 {} <"pointy" block w/multiple args> works');
+
+my $pointy_block_nested = -> $a { -> $b { $a + $b }};
+isa_ok($pointy_block_nested, Block);
+isa_ok($pointy_block_nested(5), Block);
+is $pointy_block_nested(5)(6), 11, '-> $a { -> $b { $a+$b }} nested <"pointy" block> works';
+
+# L<S06/"Blocks">
+# bare blocks
+
+my $foo;
+{$foo = "blah"};
+is($foo, "blah", "lone block actually executes it's content");
+
+my $foo2;
+{$foo2 = "blah"};
+is($foo2, "blah", "lone block w/out a semicolon actually executes it's content");
+
+my $foo3;
+({$foo3 = "blah"});
+ok(!defined($foo3), "block enclosed by parentheses should not auto-execute (1)", :todo<bug>);
+
+my $foo4;
+({$foo4 = "blah"},);
+ok(!defined($foo4), "block enclosed by parentheses should not auto-execute (2)");
+
+my ($one, $two);
+# The try's here because it should die: $foo{...} should only work if $foo isa
+# Hash (or sth. which provides appropriate tieing/&postcircumfix:<{
+# }>/whatever, but a Code should surely not support hash access).
+# Additionally, a smart compiler will detect thus errors at compile-time, so I
+# added an eval(). --iblech
+try { eval '0,{$one = 1}{$two = 2}' };
+is($one, undef, 'two blocks ({} {}) no semicolon after either,.. first block does not execute');
+is($two, 2, '... but second block does (parsed as hash subscript)');
+
+my ($one_a, $two_a);
+{$one_a = 1}; {$two_a = 2}
+is($one_a, 1, '... two blocks ({}; {}) semicolon after the first only,.. first block does execute');
+is($two_a, 2, '... and second block does too');
+
+my ($one_b, $two_b);
+{
+ $one_b = 1
+}
+{
+ $two_b = 2
+};
+is($one_b, 1, '... two stand-alone blocks ({\n...\n}\n{\n...\n}),.. first block does execute');
+is($two_b, 2, '... and second block does too');
+
+my ($one_c, $two_c);
+{$one_c = 1}; {$two_c = 2};
+is($one_c, 1, '... two blocks ({}; {};) semicolon after both,.. first block does execute');
+is($two_c, 2, '... and second block does too');
+
+sub f { { 3 } }
+is(f(), 3, 'bare blocks immediately runs even as the last statement');
+is((sub { { 3 } }).(), 3, 'ditto for anonymous subs');
+is((sub { { { 3 } } }).(), 3, 'ditto, even if nested');
+dies_ok({(sub { { $^x } }).()}, 'implicit params become errors');
+isnt((sub { -> { 3 } }).(), 3, 'as are pointies');
@@ -0,0 +1,188 @@
+use v6;
+
+use Test;
+
+=kwid
+
+Arrays
+
+=cut
+
+plan 71;
+
+#L<S02/Mutable types/Array>
+
+# array of strings
+
+my @array1 = ("foo", "bar", "baz");
+isa_ok(@array1, 'Array');
+
+is(+@array1, 3, 'the array1 has 3 elements');
+is(@array1[0], 'foo', 'got the right value at array1 index 0');
+is(@array1[1], 'bar', 'got the right value at array1 index 1');
+is(@array1[2], 'baz', 'got the right value at array1 index 2');
+
+is(@array1.[0], 'foo', 'got the right value at array1 index 0 using the . notation');
+
+# array with strings, numbers and undef
+
+my @array2 = ("test", 1, undef);
+isa_ok(@array2, 'Array');
+
+is(+@array2, 3, 'the array2 has 3 elements');
+is(@array2[0], 'test', 'got the right value at array2 index 0');
+is(@array2[1], 1, 'got the right value at array2 index 1');
+is(@array2[2], undef, 'got the right value at array2 index 2');
+
+# combine 2 arrays
+
+my @array3 = (@array1, @array2);
+isa_ok(@array3, 'Array');
+
+is(+@array3, 6, 'the array3 has 6 elements');
+is(@array3[0], 'foo', 'got the right value at array3 index 0');
+is(@array3[1], 'bar', 'got the right value at array3 index 1');
+is(@array3[2], 'baz', 'got the right value at array3 index 2');
+is(@array3[3], 'test', 'got the right value at array3 index 3');
+is(@array3[4], 1, 'got the right value at array3 index 4');
+is(@array3[5], undef, 'got the right value at array3 index 5');
+
+# array slice
+
+my @array4 = @array2[2, 1, 0];
+isa_ok(@array4, 'Array');
+
+is(+@array4, 3, 'the array4 has 3 elements');
+is(@array4[0], undef, 'got the right value at array4 index 0');
+is(@array4[1], 1, 'got the right value at array4 index 1');
+is(@array4[2], 'test', 'got the right value at array4 index 2');
+
+# create new array with 2 array slices
+
+my @array5 = ( @array2[2, 1, 0], @array1[2, 1, 0] );
+isa_ok(@array5, 'Array');
+
+is(+@array5, 6, 'the array5 has 6 elements');
+is(@array5[0], undef, 'got the right value at array5 index 0');
+is(@array5[1], 1, 'got the right value at array5 index 1');
+is(@array5[2], 'test', 'got the right value at array5 index 2');
+is(@array5[3], 'baz', 'got the right value at array5 index 3');
+is(@array5[4], 'bar', 'got the right value at array5 index 4');
+is(@array5[5], 'foo', 'got the right value at array5 index 5');
+
+# create an array slice with an array (in a variable)
+
+my @slice = (2, 0, 1);
+my @array6 = @array1[@slice];
+isa_ok(@array6, 'Array');
+
+is(+@array6, 3, 'the array6 has 3 elements');
+is(@array6[0], 'baz', 'got the right value at array6 index 0');
+is(@array6[1], 'foo', 'got the right value at array6 index 1');
+is(@array6[2], 'bar', 'got the right value at array6 index 2');
+
+# create an array slice with an array constructed with ()
+
+my @array7 = @array1[(2, 1, 0)];
+isa_ok(@array7, 'Array');
+
+is(+@array7, 3, 'the array7 has 3 elements');
+is(@array7[0], 'baz', 'got the right value at array7 index 0');
+is(@array7[1], 'bar', 'got the right value at array7 index 1');
+is(@array7[2], 'foo', 'got the right value at array7 index 2');
+
+# odd slices
+
+my $result1 = (1, 2, 3, 4)[1];
+is($result1, 2, 'got the right value from the slice');
+
+my $result2 = [1, 2, 3, 4][2];
+is($result2, 3, 'got the right value from the slice');
+
+# swap two elements test moved to t/op/assign.t
+
+# empty arrays
+
+my @array9;
+isa_ok(@array9, 'Array');
+is(+@array9, 0, "new arrays are empty");
+
+my @array10 = (1, 2, 3,);
+is(+@array10, 3, "trailing commas make correct array");
+
+# declare a multidimension array
+ok(eval('my @multidim[0..3; 0..1]'), "multidimension array", :todo);
+ok(eval('my @array11 is shape(2,4)'), "another way to declare a multidimension array", :todo);
+ok(eval('@array11[2,0] = 12'), "push the value to a multidimension array", :todo);
+
+# declare the array with data type
+my Int @array;
+lives_ok { @array[0] = 23 }, "stuffing Ints in an Int array works";
+dies_ok { @array[1] = $*ERR }, "stuffing IO in an Int array does not work", :todo<feature>;
+
+# indexing from the end
+my @array12 = ('a', 'b', 'c', 'e');
+is @array12[*-1],'e', "indexing from the end [*-1]";
+
+skip_rest "* not yet implemented"; exit;
+
+# end index range
+is ~@array12[*-4 .. *-2], 'a b c', "end indices [*-4 .. *-2]";
+
+# end index as lvalue
+@array12[*-1] = 'd';
+is @array12[*-1], 'd', "assigns to the correct end slice index";
+is ~@array12,'a b c d', "assignment to end index correctly alters the array";
+
+my @array13 = ('a', 'b', 'c', 'd');
+# end index range as lvalue
+@array13[*-4 .. *-1] = ('d', 'c', 'b', 'a'); # ('a'..'d').reverse
+is ~@array13, 'd c b a', "end range as lvalue";
+
+#hat trick
+my @array14 = ('a', 'b', 'c', 'd');
+my @b = 0..3;
+((@b[*-3,*-2,*-1,*-4] = @array14)= @array14[*-1,*-2,*-3,*-4]);
+
+is ~@b,
+ 'a d c b',
+ "hat trick:
+ assign to a end-indexed slice array from array
+ lvalue in assignment is then lvalue to end-indexed slice as rvalue";
+#
+
+# This test may seem overly simplistic, but it was actually a bug in PIL2JS, so
+# why not write a test for it so other backends can benefit of it, too? :)
+{
+ my @arr = (0, 1, 2, 3);
+ @arr[0] = "new value";
+ is @arr[0], "new value", "modifying of array contents (constants) works";
+}
+
+{
+ my @arr;
+ lives_ok { @arr[*-1] }, "readonly accessing [*-1] of an empty array is ok (1)";
+ ok !(try { @arr[*-1] }), "readonly accessing [*-1] of an empty array is ok (2)";
+ dies_ok { @arr[*-1] = 42 }, "assigning to [*-1] of an empty array is fatal";
+ dies_ok { @arr[*-1] := 42 }, "binding [*-1] of an empty array is fatal";
+}
+
+{
+ my @arr = (23);
+ lives_ok { @arr[*-2] }, "readonly accessing [*-2] of an one-elem array is ok (1)";
+ ok !(try { @arr[*-2] }), "readonly accessing [*-2] of an one-elem array is ok (2)";
+ dies_ok { @arr[*-2] = 42 }, "assigning to [*-2] of an one-elem array is fatal";
+ dies_ok { @arr[*-2] := 42 }, "binding [*-2] of an empty array is fatal";
+}
+
+{
+ my @arr = <a normal array with nothing funny>;
+ my $minus_one = -1;
+
+ # XXX should that even parse?
+ dies_ok { @arr[-1] }, "readonly accessing [-1] of normal array is fatal";
+ lives_ok { @arr[ $minus_one ] }, "indirectly accessing [-1] " ~
+ "through a variable is ok";
+ dies_ok { @arr[-1] = 42 }, "assigning to [-1] of a normal array is fatal";
+ dies_ok { @arr[-1] := 42 }, "binding [-1] of a normal array is fatal";
+}
@@ -0,0 +1,77 @@
+use v6;
+
+use Test;
+
+plan 12;
+
+{
+ # Compare with Perl 5:
+ # $ perl -we '
+ # my @array = qw<a b c>;
+ # my $foo = $array[100];
+ # print exists $array[30] ? "exists" : "does not exist"
+ # '
+ # does not exist
+ my @array = <a b c d>;
+ is +@array, 4, "basic sanity";
+ my $foo = @array[20];
+ # We've only *accessed* @array[20], but we haven't assigned anything to it, so
+ # @array shouldn't change. But currently, @array *is* automatically extended,
+ # i.e. @array is ("a", "b", "c", "d", undef, undef, ...). This is wrong.
+ is +@array, 4,
+ "accessing a not existing array element should not automatically extend the array";
+}
+
+{
+ my @array = <a b c d>;
+ @array[20] = 42;
+ # Now, we did assign @array[20], so @array should get automatically extended.
+ # @array should be ("a", "b", "c", "d", undef, undef, ..., 42).
+ is +@array, 21,
+ "creating an array element should automatically extend the array (1)";
+ # And, of course, @array.exists(20) has to be true -- we've just assigned
+ # @array[20].
+ ok @array.exists(20),
+ "creating an array element should automatically extend the array (2)";
+}
+
+{
+ my @array = <a b c d>;
+ my $defined = defined @array[100];
+
+ ok !$defined,
+ 'defined @array[$index_out_of_bounds] should be false';
+ is +@array, 4,
+ 'defined @array[$index_out_of_bounds] should not have altered @array';
+}
+
+{
+ my @array = <a b c d>;
+ my $defined;
+ try { $defined = defined @array[*-5]; }
+
+ ok !$defined,
+ 'defined @array[$negative_index_out_of_bounds] should be false';
+ is +@array, 4,
+ 'defined @array[$negative_index_out_of_bounds] should not have altered @array';
+}
+
+{
+ my @array = <a b c d>;
+ my $exists = @array.exists(100);
+
+ ok !$exists,
+ '@array.exists($index_out_of_bounds) should be false';
+ is +@array, 4,
+ '@array.exists($index_out_of_bounds) should not have altered @array';
+}
+
+{
+ my @array = <a b c d>;
+ my $exists = @array.exists(-5);
+
+ ok !$exists,
+ '@array.exists($negative_index_out_of_bounds) should be false';
+ is +@array, 4,
+ '@array.exists($negative_index_out_of_bounds) should not have altered @array';
+}
Oops, something went wrong.

0 comments on commit 0ca4c11

Please sign in to comment.