Permalink
Browse files

[t] move some junction tests

git-svn-id: http://svn.pugscode.org/pugs@22938 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
1 parent d75b5b3 commit 57e7ad801204b0efee92a4b27c12bd0556445f9f moritz committed Nov 9, 2008
Showing with 78 additions and 1 deletion.
  1. +29 −0 S03-junctions/autothreading.t
  2. +39 −0 S03-junctions/basic.t
  3. +10 −1 S03-junctions/misc.t
@@ -0,0 +1,29 @@
+use v6;
+use Test;
+
+plan 2;
+
+{
+ # Solves the equatioin A + B = A * C for integers
+ # by autothreading over all interesting values
+
+ my $n = 0;
+ sub is_it($a, $b, $c) {
+ $n++;
+ if ($a != $b && $b != $c && $a != $c &&
+ $a * 10 + $c == $a + $b ) {
+ return "$a + $b = $a$c";
+ } else {
+ return ();
+ }
+ }
+
+ # note that since the junction is not evaluated in boolean context,
+ # it's not collapsed, and the auto-threading may not abort prematurely
+ # when a result is found.
+ my $answer = is_it(any(1..2), any(7..9), any(0..6));
+ is($n, 42, "called lots of times :-)");
+
+ ok( $answer == "1 + 9 = 10", "found right answer");
+}
+
View
@@ -0,0 +1,39 @@
+use v6;
+
+use Test;
+
+plan 22;
+
+=begin pod
+
+More Junction Tests
+
+These tests are derived from the Perl6 and Parrot Essentials Chapter 4, page 42
+
+=end pod
+
+my $j = any(1, 2, 3);
+ok $j ~~ Junction, '$j is a Junction';
+
+my @values = $j.values.sort;
+is(+@values, 3, 'our junction has three values in it');
+
+is(@values[0], 1, 'our junctions first value is 1');
+is(@values[1], 2, 'our junctions second value is 2');
+is(@values[2], 3, 'our junctions third value is 3');
+
+my $sums = $j + 3;
+
+ok $sums ~~ Junction, '$j + 3 is also a Junction';
+
+my @sums_values = sort $sums.values;
+is(+@sums_values, 3, 'our junction has three values in it');
+is(@sums_values[0], 4, 'our junctions first value is 4');
+is(@sums_values[1], 5, 'our junctions second value is 5');
+is(@sums_values[2], 6, 'our junctions third value is 6');
+
+# loop enough to go through it twice
+for (1 .. 6) {
+ ok((1 ^ 2 ^ 3) == $j.values.pick, 'it is always at least one');
+ ok((1 | 2 | 3) == $j.values.pick, 'it is always one of them');
+}
View
@@ -2,7 +2,7 @@ use v6;
use Test;
-plan 76;
+plan 78;
=begin pod
@@ -323,3 +323,12 @@ ok(!(?(1&0) != ?(1&&0)), 'boolean context');
$c++ if 1 == any(1, 2, 3);
is $c, 1, 'if modifier with junction should be called once';
}
+
+{
+ my @array = <1 2 3 4 5 6 7 8>;
+ ok( all(@array) == one(@array), "all(@x) == one(@x) tests uniqueness(+ve)" );
+
+ push @array, 6;
+ ok( !( all(@array) == one(@array) ), "all(@x) == one(@x) tests uniqueness(-ve)" );
+
+}

0 comments on commit 57e7ad8

Please sign in to comment.