Patched Test.pm and test for Test.pm #122

p6rt · 2008-06-07T07:21:43Z

Migrated from rt.perl.org#55438 (status was 'resolved')

Searchable as RT55438$

p6rt · 2008-06-07T07:21:46Z

From @bacek

Hello.

There is patched Test.pm which allows unittest it. Provide method to
override 'proclaim()' from external program to check it invocation.

Also attached 'test.t' for it. I just don't know best place for this test.

And whole Test.pm just in case :)

--
Bacek.

p6rt · 2008-06-07T07:21:46Z

From @bacek

test.diff

diff --git a/languages/perl6/Test.pm b/languages/perl6/Test.pm
index 5cb04ae..e113af7 100644
--- a/languages/perl6/Test.pm
+++ b/languages/perl6/Test.pm
@@ -14,9 +14,16 @@ our $todo_reason = '';
 # for running the test suite multiple times in the same process
 our $testing_started;
 
+# for unittesting of Test.pm we override 'proclaim'
+our &proclaim := &real_proclaim;
+
+sub set_proclaim($proc) {
+	&proclaim := $proc;
+}
 
 ## test functions
 
+
 # Compare numeric values with approximation
 sub approx ($x, $y) {
     my $epsilon = 0.00001;
@@ -33,14 +40,14 @@ sub plan($number_of_tests) {
 
 
 multi sub ok($cond, $desc) {
-    proclaim($cond, $desc);
+    &proclaim($cond, $desc);
 }
 
 multi sub ok($cond) { ok($cond, ''); }
 
 
 multi sub nok($cond, $desc) {
-    proclaim(!$cond, $desc);
+    &proclaim(!$cond, $desc);
 }
 
 multi sub nok($cond) { nok(!$cond, ''); }
@@ -48,7 +55,7 @@ multi sub nok($cond) { nok(!$cond, ''); }
 
 multi sub is($got, $expected, $desc) {
     my $test = $got eq $expected;
-    proclaim($test, $desc);
+    &proclaim($test, $desc);
 }
 
 multi sub is($got, $expected) { is($got, $expected, ''); }
@@ -56,14 +63,14 @@ multi sub is($got, $expected) { is($got, $expected, ''); }
 
 multi sub isnt($got, $expected, $desc) {
     my $test = !($got eq $expected);
-    proclaim($test, $desc);
+    &proclaim($test, $desc);
 }
 
 multi sub isnt($got, $expected) { isnt($got, $expected, ''); }
 
 multi sub is_approx($got, $expected, $desc) {
     my $test = abs($got - $expected) <= 0.00001;
-    proclaim($test, $desc);
+    &proclaim($test, $desc);
 }
 
 multi sub is_approx($got, $expected) { is_approx($got, $expected, ''); }
@@ -78,11 +85,11 @@ multi sub todo($reason) {
     $todo_reason = '# TODO ' ~ $reason;
 }
 
-multi sub skip()                { proclaim(1, "# SKIP"); }
-multi sub skip($reason)         { proclaim(1, "# SKIP " ~ $reason); }
+multi sub skip()                { &proclaim(1, "# SKIP"); }
+multi sub skip($reason)         { &proclaim(1, "# SKIP " ~ $reason); }
 multi sub skip($count, $reason) {
     for 1..$count {
-        proclaim(1, "# SKIP " ~ $reason);
+        &proclaim(1, "# SKIP " ~ $reason);
     }
 }
 
@@ -97,16 +104,20 @@ multi sub skip_rest($reason) {
 sub diag($message) { say '# '~$message; }
 
 
-multi sub flunk($reason) { proclaim(0, "flunk $reason")}
+multi sub flunk($reason) { &proclaim(0, "flunk $reason")}
 
 
 sub isa_ok($var,$type) { ok($var.isa($type), "The object is-a '$type'"); }
 
 multi sub dies_ok($closure, $reason) {
+	our $died = 1;
     try {
         $closure();
+		$died = 0;
     }
-    proclaim((defined $!), $reason);
+	# This line is to avoid bug in rakudo. We'll remove it
+	$died = 0 + $died;
+    &proclaim($died, $reason);
 }
 multi sub dies_ok($closure) {
     dies_ok($closure, '');
@@ -115,22 +126,24 @@ multi sub dies_ok($closure) {
 multi sub lives_ok($closure, $reason) {
     try {
         $closure();
+		&proclaim(1, $reason);
     }
-    proclaim((not defined $!), $reason);
 }
 multi sub lives_ok($closure) {
     lives_ok($closure, '');
 }
 
 multi sub eval_dies_ok($code, $reason) {
-    proclaim((defined eval_exception($code)), $reason);
+	eval($code);
+    &proclaim(defined($!), $reason);
 }
 multi sub eval_dies_ok($code) {
     eval_dies_ok($code, '');
 }
 
 multi sub eval_lives_ok($code, $reason) {
-    proclaim((not defined eval_exception($code)), $reason);
+	eval($code);
+    &proclaim(!(defined $!), $reason);
 }
 multi sub eval_lives_ok($code) {
     eval_lives_ok($code, '');
@@ -139,13 +152,7 @@ multi sub eval_lives_ok($code) {
 
 ## 'private' subs
 
-sub eval_exception($code) {
-    my $eval_exception;
-    try { eval ($code); $eval_exception = $! }
-    $eval_exception // $!;
-}
-
-sub proclaim($cond, $desc) {
+sub real_proclaim($cond, $desc) {
     $testing_started  = 1;
     $num_of_tests_run = $num_of_tests_run + 1;

p6rt · 2008-06-07T07:21:46Z

From @bacek

use Test;
plan 17;

our $expect_fail = 0;

sub fake_proclaim ($cond, $desc) {
# my Int $r;
# if $cond { $r = 1 } else { $r = 0 };
# my $res = $r xor $expect_fail;
# say $res;
# say $res.WHAT;
# say join ' ', $cond.WHAT, $cond, $r.WHAT, $r, $expect_fail.WHAT, $expect_fail, $res.WHAT, $res;
# say $desc;
my $res;
if $cond {
if $expect_fail {
$res = 0;
}
else {
$res = 1;
}
}
else {
if $expect_fail {
$res = 1;
}
else {
$res = 0;
}
}
real_proclaim($res, $desc);
}

set_proclaim(&fake_proclaim);

## ok

$expect_fail = 0;
ok(2 + 2 == 4, '2 and 2 make 4');

$expect_fail = 1;
ok(2 + 2 == 5, '2 and 2 doesnt make 5');

# nok

$expect_fail = 1;
nok(2 + 2 == 4, '2 and 2 make 4');

$expect_fail = 0;
nok(2 + 2 == 5, '2 and 2 doesnt make 5');

## is

$expect_fail = 0;
is(2 + 2, 4, '2 and 2 make 4');

$expect_fail = 1;
is(2 + 2, 5, '2 and 2 doesnt make 5');

## isnt
$expect_fail = 0;
isnt(2 + 2, 5, '2 and 2 does not make 5');

$expect_fail = 1;
isnt(2 + 2, 4, '2 and 2 does make 4');

## todo

## skip

## dies_ok

$expect_fail = 0;
dies_ok { die "Testing dies_ok" }, '... it dies_ok';

$expect_fail = 1;
dies_ok { "Testing dies_ok" }, '... it dies_ok';

## lives_ok

$expect_fail = 0;
lives_ok { "test" }, '... it lives_ok';

$expect_fail = 1;
lives_ok { die "test" }, '... it lives_ok';

## eval_dies_ok

$expect_fail = 0;
eval_dies_ok('<', '... it eval_dies_ok during parsing');
eval_dies_ok('die', '... it eval_dies_ok during evaluation ');

$expect_fail = 1;
eval_dies_ok('my $a;', '... it dies in eval');

## eval_lives_ok
$expect_fail = 0;
eval_lives_ok('1', '... it eval_lives_ok');

$expect_fail = 1;
eval_lives_ok('<', '... it eval_lives_ok');
eval_lives_ok('die', '... it eval_lives_ok');

## diag

#diag('some misc comments and documentation');

## pass

#pass('This test passed');

## flunk

#flunk('This test failed', todo => 1);
#flunk('This test failed', :todo(1));

## skip

#skip('skip this test for now');
#skip(3, 'skip 3 more tests for now');
#skip_rest('skipping the rest');

1;

p6rt · 2008-06-07T07:21:46Z

From @bacek

Test.pm

p6rt · 2008-06-07T07:30:53Z

From @bacek

On Sat Jun 07 00:21:46 2008, bacek wrote:

Sorry, there is clean version of test.t

--
Bacek.

p6rt · 2008-06-07T07:30:53Z

From @bacek

use Test;
plan 17;

our $expect_fail = 0;

sub fake_proclaim ($cond, $desc) {
real_proclaim(($cond xor $expect_fail), $desc);
}

set_proclaim(&fake_proclaim);

## ok

$expect_fail = 0;
ok(2 + 2 == 4, '2 and 2 make 4');

$expect_fail = 1;
ok(2 + 2 == 5, '2 and 2 doesnt make 5');

# nok

$expect_fail = 1;
nok(2 + 2 == 4, '2 and 2 make 4');

$expect_fail = 0;
nok(2 + 2 == 5, '2 and 2 doesnt make 5');

## is

$expect_fail = 0;
is(2 + 2, 4, '2 and 2 make 4');

$expect_fail = 1;
is(2 + 2, 5, '2 and 2 doesnt make 5');

## isnt
$expect_fail = 0;
isnt(2 + 2, 5, '2 and 2 does not make 5');

$expect_fail = 1;
isnt(2 + 2, 4, '2 and 2 does make 4');

## todo

## skip

## dies_ok

$expect_fail = 0;
dies_ok { die "Testing dies_ok" }, '... it dies_ok';

$expect_fail = 1;
dies_ok { "Testing dies_ok" }, '... it dies_ok';

## lives_ok

$expect_fail = 0;
lives_ok { "test" }, '... it lives_ok';

$expect_fail = 1;
lives_ok { die "test" }, '... it lives_ok';

## eval_dies_ok

$expect_fail = 0;
eval_dies_ok('<', '... it eval_dies_ok during parsing');
eval_dies_ok('die', '... it eval_dies_ok during evaluation ');

$expect_fail = 1;
eval_dies_ok('my $a;', '... it dies in eval');

## eval_lives_ok
$expect_fail = 0;
eval_lives_ok('1', '... it eval_lives_ok');

$expect_fail = 1;
eval_lives_ok('<', '... it eval_lives_ok');
eval_lives_ok('die', '... it eval_lives_ok');

## diag

#diag('some misc comments and documentation');

## pass

#pass('This test passed');

## flunk

#flunk('This test failed', todo => 1);
#flunk('This test failed', :todo(1));

## skip

#skip('skip this test for now');
#skip(3, 'skip 3 more tests for now');
#skip_rest('skipping the rest');

1;

p6rt · 2008-06-07T07:30:56Z

@bacek - Status changed from 'new' to 'open'

p6rt · 2008-06-20T20:57:29Z

From @bacek

Simplified version of patch made after discussion with jonathan.

p6rt · 2008-06-20T20:57:29Z

From @bacek

test2.diff

diff --git a/languages/perl6/Test.pm b/languages/perl6/Test.pm
index 5cb04ae..aec9daf 100644
--- a/languages/perl6/Test.pm
+++ b/languages/perl6/Test.pm
@@ -14,6 +14,13 @@ our $todo_reason = '';
 # for running the test suite multiple times in the same process
 our $testing_started;
 
+# Default binding of proclaim()
+our &proclaim := &real_proclaim;
+
+# Override proclaim for testing purpose
+sub set_proclaim($proc) {
+	&proclaim := $proc;
+}
 
 ## test functions
 
@@ -145,7 +152,7 @@ sub eval_exception($code) {
     $eval_exception // $!;
 }
 
-sub proclaim($cond, $desc) {
+sub real_proclaim($cond, $desc) {
     $testing_started  = 1;
     $num_of_tests_run = $num_of_tests_run + 1;
 
diff --git a/languages/perl6/src/builtins/control.pir b/languages/perl6/src/builtins/control.pir
index 4fe2b5d..e136fe2 100644
--- a/languages/perl6/src/builtins/control.pir
+++ b/languages/perl6/src/builtins/control.pir
@@ -135,10 +135,10 @@ on error.
 
     .local pmc compiler, invokable
     .local pmc res, exception
+    push_eh catch
     compiler = compreg 'Perl6'
     invokable = compiler.'compile'(code)
 
-    push_eh catch
     res = invokable()
     pop_eh
     exception = new 'Failure'
diff --git a/languages/perl6/t/02-test-pm/6-full.t b/languages/perl6/t/02-test-pm/6-full.t
new file mode 100644
index 0000000..6e40a46
--- /dev/null
+++ b/languages/perl6/t/02-test-pm/6-full.t
@@ -0,0 +1,102 @@
+use Test;
+plan 18;
+
+our $expect_fail = 0;
+
+sub fake_proclaim ($cond, $desc) {
+	real_proclaim(($cond xor $expect_fail), $desc);
+}
+
+set_proclaim(&fake_proclaim);
+
+
+## ok
+
+$expect_fail = 0;
+ok(2 + 2 == 4, '2 and 2 make 4');
+
+$expect_fail = 1;
+ok(2 + 2 == 5, '2 and 2 doesnt make 5');
+
+# nok
+
+$expect_fail = 1;
+nok(2 + 2 == 4, '2 and 2 make 4');
+
+$expect_fail = 0;
+nok(2 + 2 == 5, '2 and 2 doesnt make 5');
+
+## is
+
+$expect_fail = 0;
+is(2 + 2, 4, '2 and 2 make 4');
+
+$expect_fail = 1;
+is(2 + 2, 5, '2 and 2 doesnt make 5');
+
+## isnt
+$expect_fail = 0;
+isnt(2 + 2, 5, '2 and 2 doesnt make 5');
+
+$expect_fail = 1;
+isnt(2 + 2, 4, '2 and 2 does make 4');
+
+## todo
+
+## skip
+
+## dies_ok
+
+$expect_fail = 0;
+dies_ok { die "Testing dies_ok" }, '... it dies_ok';
+
+$expect_fail = 1;
+dies_ok { "Testing dies_ok" }, '... it dies_ok';
+
+## lives_ok
+
+$expect_fail = 0;
+lives_ok { "test" }, '... it lives_ok';
+
+$expect_fail = 1;
+lives_ok { die "test" }, '... it lives_ok for catching failures';
+
+## eval_dies_ok
+
+$expect_fail = 0;
+eval_dies_ok('<', '... it eval_dies_ok during parsing');
+eval_dies_ok('die', '... it eval_dies_ok during evaluation ');
+
+$expect_fail = 1;
+eval_dies_ok('my $a;', '... it dies for catching failures');
+
+## eval_lives_ok
+$expect_fail = 0;
+eval_lives_ok('1', '... it eval_lives_ok');
+
+$expect_fail = 1;
+eval_lives_ok('<', '... it eval_lives_ok for catching failures during parsing');
+eval_lives_ok('die', '... it eval_lives_ok for catching failures during evaluation');
+
+
+## diag
+
+#diag('some misc comments and documentation');
+
+## pass
+
+#pass('This test passed');
+
+## flunk
+
+#flunk('This test failed', todo => 1);
+#flunk('This test failed', :todo(1));
+
+## skip
+
+#skip('skip this test for now');
+#skip(3, 'skip 3 more tests for now');
+#skip_rest('skipping the rest');
+
+1;
+

p6rt · 2008-06-21T23:10:24Z

From @bacek

Yet another version of diff. Pm likes it more than previous :)

--
Bacek.

p6rt · 2008-06-21T23:10:24Z

From @bacek

test3.diff

diff --git a/languages/perl6/Test.pm b/languages/perl6/Test.pm
index 5cb04ae..ed4d083 100644
--- a/languages/perl6/Test.pm
+++ b/languages/perl6/Test.pm
@@ -14,6 +14,12 @@ our $todo_reason = '';
 # for running the test suite multiple times in the same process
 our $testing_started;
 
+# Next tests expected to fail. Used for testing Test.pm
+our $expect_fail = 0;
+
+sub expect_fail($e) {
+	$expect_fail = $e;
+}
 
 ## test functions
 
@@ -149,7 +155,7 @@ sub proclaim($cond, $desc) {
     $testing_started  = 1;
     $num_of_tests_run = $num_of_tests_run + 1;
 
-    unless $cond {
+    unless $cond xor $expect_fail {
         print "not ";
         $num_of_tests_failed = $num_of_tests_failed + 1
             unless  $num_of_tests_run <= $todo_upto_test_num;
diff --git a/languages/perl6/src/builtins/control.pir b/languages/perl6/src/builtins/control.pir
index 4fe2b5d..e136fe2 100644
--- a/languages/perl6/src/builtins/control.pir
+++ b/languages/perl6/src/builtins/control.pir
@@ -135,10 +135,10 @@ on error.
 
     .local pmc compiler, invokable
     .local pmc res, exception
+    push_eh catch
     compiler = compreg 'Perl6'
     invokable = compiler.'compile'(code)
 
-    push_eh catch
     res = invokable()
     pop_eh
     exception = new 'Failure'
diff --git a/languages/perl6/t/02-test-pm/6-full.t b/languages/perl6/t/02-test-pm/6-full.t
new file mode 100644
index 0000000..588ff81
--- /dev/null
+++ b/languages/perl6/t/02-test-pm/6-full.t
@@ -0,0 +1,93 @@
+use Test;
+plan 22;
+
+## ok
+
+expect_fail(0);
+ok(2 + 2 == 4, '2 and 2 make 4');
+
+expect_fail(1);
+ok(2 + 2 == 5, '2 and 2 doesnt make 5');
+
+# nok
+
+expect_fail(1);
+nok(2 + 2 == 4, '2 and 2 make 4');
+
+expect_fail(0);
+nok(2 + 2 == 5, '2 and 2 doesnt make 5');
+
+## is
+
+expect_fail(0);
+is(2 + 2, 4, '2 and 2 make 4');
+
+expect_fail(1);
+is(2 + 2, 5, '2 and 2 doesnt make 5');
+
+## isnt
+expect_fail(0);
+isnt(2 + 2, 5, '2 and 2 doesnt make 5');
+
+expect_fail(1);
+isnt(2 + 2, 4, '2 and 2 does make 4');
+
+## todo
+
+## skip
+
+## dies_ok
+
+expect_fail(0);
+dies_ok { die "Testing dies_ok" }, '... it dies_ok';
+
+expect_fail(1);
+dies_ok { "Testing dies_ok" }, '... it dies_ok';
+
+## lives_ok
+
+expect_fail(0);
+lives_ok { "test" }, '... it lives_ok';
+
+expect_fail(1);
+lives_ok { die "test" }, '... it lives_ok for catching failures';
+
+## eval_dies_ok
+
+expect_fail(0);
+eval_dies_ok('<', '... it eval_dies_ok during parsing');
+eval_dies_ok('die', '... it eval_dies_ok during evaluation ');
+
+expect_fail(1);
+eval_dies_ok('my $a;', '... it dies for catching failures');
+
+## eval_lives_ok
+expect_fail(0);
+eval_lives_ok('1', '... it eval_lives_ok');
+
+expect_fail(1);
+eval_lives_ok('<', '... it eval_lives_ok for catching failures during parsing');
+eval_lives_ok('die', '... it eval_lives_ok for catching failures during evaluation');
+
+## diag
+
+diag('some misc comments and documentation');
+
+## pass
+
+#pass('This test passed');
+
+## flunk
+
+#flunk('This test failed', todo => 1);
+#flunk('This test failed', :todo(1));
+
+## skip
+
+expect_fail(0);
+skip('skip this test for now');
+skip(3, 'skip 3 more tests for now');
+#skip_rest('skipping the rest');
+
+1;
+

p6rt · 2008-12-15T17:46:10Z

From @pmichaud

Since it looks as though builtin testing functions are going to become
part of the spec (Synopsis 24), I recommend we put tests like these into
the official test suite (pugscode t/spec).

In the meantime, I'll close this ticket as resolved since the tests can
go better elsewhere.

Thanks!

Pm

p6rt · 2008-12-15T17:46:13Z

@pmichaud - Status changed from 'open' to 'resolved'

p6rt closed this as completed Dec 15, 2008

p6rt added the patch label Jan 5, 2020

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Patched Test.pm and test for Test.pm #122

Patched Test.pm and test for Test.pm #122

p6rt commented Jun 7, 2008

p6rt commented Jun 7, 2008

p6rt commented Jun 7, 2008

p6rt commented Jun 7, 2008

p6rt commented Jun 7, 2008

p6rt commented Jun 7, 2008

p6rt commented Jun 7, 2008

p6rt commented Jun 7, 2008

p6rt commented Jun 20, 2008

p6rt commented Jun 20, 2008

p6rt commented Jun 21, 2008

p6rt commented Jun 21, 2008

p6rt commented Dec 15, 2008

p6rt commented Dec 15, 2008

Patched Test.pm and test for Test.pm #122

Patched Test.pm and test for Test.pm #122

Comments

p6rt commented Jun 7, 2008

p6rt commented Jun 7, 2008

From @bacek

p6rt commented Jun 7, 2008

From @bacek

p6rt commented Jun 7, 2008

From @bacek

p6rt commented Jun 7, 2008

From @bacek

p6rt commented Jun 7, 2008

From @bacek

p6rt commented Jun 7, 2008

From @bacek

p6rt commented Jun 7, 2008

p6rt commented Jun 20, 2008

From @bacek

p6rt commented Jun 20, 2008

From @bacek

p6rt commented Jun 21, 2008

From @bacek

p6rt commented Jun 21, 2008

From @bacek

p6rt commented Dec 15, 2008

From @pmichaud

p6rt commented Dec 15, 2008