Permalink
Browse files

Some initial test refactors and cleanups for basic operators.

git-svn-id: http://svn.pugscode.org/pugs@19306 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
0 parents commit 8a1a0683a85a2d8ba952bbd7d0228a60a2101b8e pmichaud committed Jan 2, 2008
Showing with 240 additions and 0 deletions.
  1. +100 −0 S03-operators/autoincrement.t
  2. +28 −0 S03-operators/comparison.t
  3. +41 −0 S03-operators/equality.t
  4. +71 −0 S03-operators/relational.t
@@ -0,0 +1,100 @@
+use v6-alpha;
+use Test;
+
+# Tests for auto-increment and auto-decrement operators
+# originally from Perl 5, by way of t/operators/auto.t
+
+plan 42;
+
+#L<S03/Autoincrement precedence>
+
+my $base = 10000;
+
+my $x = 10000;
+is(0 + ++$x - 1, $base);
+is(0 + $x-- - 1, $base);
+is(1 * $x, $base);
+is(0 + $x-- - 0, $base);
+is(1 + $x, $base);
+is(1 + $x++, $base);
+is(0 + $x, $base);
+is(0 + --$x + 1, $base);
+is(0 + ++$x + 0, $base);
+is($x, $base);
+
+my @x;
+@x[0] = 10000;
+is(0 + ++@x[0] - 1, $base);
+is(0 + @x[0]-- - 1, $base);
+is(1 * @x[0], $base);
+is(0 + @x[0]-- - 0, $base);
+is(1 + @x[0], $base);
+is(1 + @x[0]++, $base);
+is(0 + @x[0], $base);
+is(0 + ++@x[0] - 1, $base);
+is(0 + --@x[0] + 0, $base);
+is(@x[0], $base);
+
+my %z;
+%z{0} = 10000;
+is(0 + ++%z{0} - 1, $base);
+is(0 + %z{0}-- - 1, $base);
+is(1 * %z{0}, $base);
+is(0 + %z{0}-- - 0, $base);
+is(1 + %z{0}, $base);
+is(1 + %z{0}++, $base);
+is(0 + %z{0}, $base);
+is(0 + ++%z{0} - 1, $base);
+is(0 + --%z{0} + 0, $base);
+is(%z{0}, $base);
+
+# Increment of a Str
+#L<S03/Autoincrement precedence/Increment of a>
+
+# XXX: these need to be re-examined and extended per changes to S03.
+# Also, see the thread at
+# http://www.nntp.perl.org/group/perl.perl6.compiler/2007/06/msg1598.html
+# which prompted many of the changes to Str autoincrement/autodecrement.
+
+my $foo;
+
+$foo = '99';
+is(++$foo, '100');
+
+$foo = 'a0';
+is(++$foo, 'a1');
+
+$foo = 'Az';
+is(++$foo, 'Ba');
+
+$foo = 'zz';
+is(++$foo, 'aaa');
+
+$foo = 'A99';
+is(++$foo, 'B00');
+
+# EBCDIC guards: i and j, r and s, are not contiguous.
+$foo = 'zi';
+is(++$foo, 'zj');
+
+$foo = 'zr';
+is(++$foo, 'zs');
+
+# test magical autodecrement
+$foo = '100';
+is(--$foo, '99');
+
+$foo = 'a1';
+is(--$foo, 'a0');
+
+$foo = 'Ba';
+is(--$foo, 'Az');
+
+$foo = 'aaa';
+is(--$foo, 'zz');
+
+$foo = 'B00';
+is(--$foo, 'A99');
+
+# $foo = 'A00';
+# dies_ok( { --$foo }, 'autodecrementing A00 fails' );
@@ -0,0 +1,28 @@
+use v6-alpha;
+use Test;
+
+plan 9;
+
+# N.B.: relational ops are in relational.t
+
+#L<S03/Comparison semantics>
+
+# spaceship comparisons (Num)
+is(1 <=> 1, 0, '1 <=> 1 is same');
+is(1 <=> 2, -1, '1 <=> 2 is increase');
+is(2 <=> 1, 1, '2 <=> 1 is decrease');
+
+# leg comparison (Str)
+is('a' leg 'a', 0, 'a leg a is same');
+is('a' leg 'b', -1, 'a leg b is increase');
+is('b' leg 'a', 1, 'b leg a is decrease');
+
+#L<S03/Comparison semantics>
+#L<S29/Any/"=item cmp">
+
+# cmp comparison
+is('a' cmp 'a', 0, 'a cmp a is same');
+is('a' cmp 'b', -1, 'a cmp b is increase');
+is('b' cmp 'a', 1, 'b cmp a is decrease');
+
+
@@ -0,0 +1,41 @@
+use v6-alpha;
+use Test;
+
+plan 15;
+
+# adapted from t/operators/eq.t and t/operators/cond.t
+# relational ops are in relational.t
+# cmp, leq, <=>, etc. are in comparison.t
+
+#L<S03/Chaining binary precedence>
+#L<S03/Comparison semantics>
+
+# string equality & inequality
+ok("a" eq "a", "eq true");
+ok(!("a" eq "ab"), "eq false");
+ok("a" ne "ab", "ne true");
+ok(!("a" ne "a"), "ne false");
+
+# potential problem cases
+ok("\0" eq "\0", "eq on strings with null chars");
+
+# string context on undef values
+my $foo;
+ok($foo eq "", "Undef eq ''");
+ok($foo ne "f", "Undef ne 'f'");
+
+my @foo;
+ok(@foo[0] eq "", "Array undef eq ''");
+ok(@foo[0] ne "f", "Array undef ne 'f'");
+
+# numeric equality & inequality
+ok(2 == 2, "== true");
+ok(!(2 == 3), "== false");
+ok(2 != 3, "!= true");
+ok(!(2 != 2), "!= false");
+
+# numeric context on undef values
+ok($foo == 0, "Undef == 0");
+ok(@foo[0] == 0, "Array undef == 0");
+
+# XXX: need tests for coercion string and numeric coercions
@@ -0,0 +1,71 @@
+use v6-alpha;
+use Test;
+
+plan 36;
+
+## N.B.: Tests for infix:«<=>» (spaceship) and infix:<cmp> belong
+## in F<t/S03-operators/comparison.t>.
+
+#L<S03/Chaining binary precedence>
+
+# from t/operators/relational.t
+
+## numeric relationals ( < , >, <=, >= )
+
+ok(1 < 2, '1 is less than 2');
+ok(!(2 < 1), '2 is ~not~ less than 1');
+
+ok(2 > 1, '2 is greater than 1');
+ok(!(1 > 2), '1 is ~not~ greater than 2');
+
+ok(1 <= 2, '1 is less than or equal to 2');
+ok(1 <= 1, '1 is less than or equal to 1');
+ok(!(1 <= 0), '1 is ~not~ less than or equal to 0');
+
+ok(2 >= 1, '2 is greater than or equal to 1');
+ok(2 >= 2, '2 is greater than or equal to 2');
+ok(!(2 >= 3), '2 is ~not~ greater than or equal to 3');
+
+## XXX: need tests for numeric coercion
+
+## string relationals ( lt, gt, le, ge )
+
+ok('a' lt 'b', 'a is less than b');
+ok(!('b' lt 'a'), 'b is ~not~ less than a');
+
+ok('b' gt 'a', 'b is greater than a');
+ok(!('a' gt 'b'), 'a is ~not~ greater than b');
+
+ok('a' le 'b', 'a is less than or equal to b');
+ok('a' le 'a', 'a is less than or equal to a');
+ok(!('b' le 'a'), 'b is ~not~ less than or equal to a');
+
+ok('b' ge 'a', 'b is greater than or equal to a');
+ok('b' ge 'b', 'b is greater than or equal to b');
+ok(!('b' ge 'c'), 'b is ~not~ greater than or equal to c');
+
+## XXX: need tests for string coercion
+
+## Multiway comparisons (RFC 025)
+# L<S03/"Chained comparisons">
+
+ok(5 > 4 > 3, "chained >");
+ok(3 < 4 < 5, "chained <");
+ok(5 == 5 > -5, "chained mixed = and > ");
+ok(!(3 > 4 < 5), "chained > and <");
+ok(5 <= 5 > -5, "chained <= and >");
+ok(-5 < 5 >= 5, "chained < and >=");
+
+is(5 > 1 < 10, 5 > 1 && 1 < 10, 'chained 5 > 1 < 10');
+is(5 < 1 < 10, 5 < 1 && 1 < 10, 'chained 5 < 1 < 10');
+
+ok('e' gt 'd' gt 'c', "chained gt");
+ok('c' lt 'd' lt 'e', "chained lt");
+ok('e' eq 'e' gt 'a', "chained mixed = and gt ");
+ok(!('c' gt 'd' lt 'e'), "chained gt and lt");
+ok('e' le 'e' gt 'a', "chained le and gt");
+ok('a' lt 'e' ge 'e', "chained lt and ge");
+
+is('e' gt 'a' lt 'j', 'e' gt 'a' && 'a' lt 'j', 'e gt a lt j');
+is('e' lt 'a' lt 'j', 'e' lt 'a' && 'a' lt 'j', 'e lt a lt j');
+

0 comments on commit 8a1a068

Please sign in to comment.