Permalink
Browse files

[t] and [t/spec]

 * more smartlinks
 * moved passing_the_pair_class_to_a_sub.t to spec/integration.t
 * test that optional params can't go before positional ones
 * test that MAIN sub in eval() is not executed
 * moved var/contextual.t, a vew oo/roles/*.t and blocks/wrap.t to spec/
 * removed outdated oo/roles/properties.t
 * moved arity tests to spec/, updated and enhanced
 * remove unneeded evals
 * merge oo/class/anonymous.t into spec/S12-class/anonymous.t


git-svn-id: http://svn.pugscode.org/pugs@24553 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
1 parent 7367c91 commit 288e0461910923b9e66284577fa3a28af85900ec moritz committed Dec 22, 2008
@@ -0,0 +1,27 @@
+use v6;
+
+use Test;
+
+plan 5;
+
+# L<S02/Names/it then looks in C<%*ENV> for the identifier of the variable>
+
+%*ENV<THIS_NEVER_EXISTS> = 123;
+
+{
+ is $+THIS_NEVER_EXISTS, 123, "Testing contextual variable which changed within %*ENV";
+}
+
+{
+ %*ENV.delete('THIS_NEVER_EXISTS');
+ my $rv = eval('$+THIS_NEVER_EXISTS');
+ ok $!, "Testing for accessing contextual which is deleted.";
+ is $rv, undef, "Testing for value of contextual variables that was deleted.";
+}
+
+{
+ my $rv = eval('$+THIS_IS_NEVER_THERE_EITHER');
+ ok $!, "Test for contextual which doesn't exists.";
+ is $rv, undef, "Testing for value of contextual variables that never existed.";
+}
+
View
@@ -10,6 +10,8 @@ More Junction Tests
These tests are derived from the Perl6 and Parrot Essentials Chapter 4, page 42
+L<S03/Junctive operators/>
+
=end pod
my $j = any(1, 2, 3);
@@ -3,6 +3,8 @@ use Test;
plan 11;
+# L<S05/Grammars/"Like classes, grammars can inherit">
+
# tests namespace, inheritance and override
grammar Grammar::Foo {
View
@@ -2,6 +2,9 @@ use v6;
use Test;
plan 8;
+# L<S05/Modifiers/"causes whitespace sequences to be considered">
+# L<S05/Modifiers/"any grammar is free to override the rule">
+
# test that implicit and explicit <.ws> rules are overridable
grammar T1 {
token ws { 'x' };
View
@@ -10,6 +10,8 @@ version 0.3 (12 Apr 2004), file t/stdrules.t.
It has (hopefully) been, and should continue to be, updated to
be valid perl6.
+L<S05/Extensible metasyntax (C<< <...> >>)/"The special named assertions include">
+
=end pod
plan 184;
@@ -8,6 +8,9 @@ version 0.3 (12 Apr 2004), file t/noncap.t.
=end pod
+# L<S05/Bracket rationalization/"[...] is no longer a character class.
+# It now delimits a non-capturing group.">
+
plan 8;
if !eval('("a" ~~ /a/)') {
@@ -0,0 +1,101 @@
+use v6;
+
+use Test;
+
+# L<S06/Wrapping>
+
+# TODO
+# nextsame, callwith
+# named wrapping/unwrapping
+# unwrap with no args pops the top most
+#
+# mutating wraps -- those should be "deep", as in not touching coderefs
+# but actually mutating how the coderef works.
+#
+# of course, if we allow assigning into coderefs, then the wrap semantic
+# could become a simple reassignment; but that is unspecced.
+
+plan 20;
+
+my @log;
+
+sub foo {
+ push @log, "foo";
+}
+
+sub wrapper {
+ push @log, "wrapper before";
+ try { callsame };
+ push @log, "wrapper after";
+}
+
+sub other_wrapper (|$args) {
+ push @log, "wrapper2";
+ try { nextwith(|$args) };
+}
+
+foo();
+is(+@log, 1, "one event logged");
+is(@log[0], "foo", "it's foo");
+
+@log = ();
+
+wrapper();
+is(+@log, 2, "two events logged");
+is(@log[0], "wrapper before", "wrapper before");
+is(@log[1], "wrapper after", "wrapper after");
+
+@log = ();
+
+my $wrapped;
+try {
+ $wrapped = &foo.wrap(&wrapper);
+};
+
+#?pugs 99 todo 'feature: wrapping'
+isa_ok($wrapped, Sub);
+
+$wrapped ||= -> { };
+try { $wrapped.() };
+
+is(+@log, 3, "three events logged");
+is(@log[0], "wrapper before", "wrapper before");
+is(@log[1], "foo", "the wrapped sub");
+is(@log[2], "wrapper after", "wrapper after");
+
+@log = ();
+
+my $doublywrapped;
+try {
+ $doublywrapped = $wrapped.wrap(&other_wrapper);
+};
+
+isa_ok($doublywrapped, Sub);
+$doublywrapped ||= -> { };
+try { $doublywrapped.() };
+
+is(+@log, 4, "four events");
+is(@log[0], "wrapper2", "additional wrapping takes effect");
+is(@log[1], "wrapper before", "... on top of initial wrapping");
+
+@log = ();
+
+try { $wrapped.() };
+is(+@log, 3, "old wrapped sub was not destroyed");
+is(@log[0], "wrapper before", "the original wrapper is still in effect");
+
+
+@log = ();
+
+my $unwrapped;
+try {
+ $unwrapped = $wrapped.unwrap(&wrapper);
+};
+
+isa_ok($unwrapped, Sub);
+$unwrapped ||= -> {};
+try { $unwrapped.() };
+
+is(+@log, 2, "two events for unwrapped");
+is(@log[0], "wrapper2");
+is(@log[1], "foo");
View
@@ -2,13 +2,15 @@ use v6;
use Test;
-plan 5;
+plan 6;
## If this test file is fudged, then MAIN never executes because
## the fudge script introduces an C<exit(1)> into the mainline.
## This definition prevents that insertion from having any effect. :-)
sub exit { }
+# L<S06/Declaring a C<MAIN> subroutine/>
+
sub MAIN($a, $b, *@c) {
ok(1, 'MAIN called correctly');
is($a, 'a', 'first positional param set correctly');
@@ -22,3 +24,14 @@ sub MAIN($a, $b, *@c) {
ok( @*ARGS == 5, '@*ARGS has correct elements');
+# L<S06/Declaring a C<MAIN> subroutine/"the compilation unit was directly
+# invoked rather than by being required by another compilation unit">
+
+# a MAIN sub in eval() shouldn't be called
+
+my $invoked = 0;
+eval 'temp @*ARGS = <a b>; sub MAIN($a, $b) { $invoked = 0 };';
+#?rakudo skip 'temp(), lexicals shared in eval()'
+is $invoked, 0, 'sub MAIN is not called in eval()';
+
+# vim: ft=perl6
View
@@ -0,0 +1,73 @@
+use v6;
+
+use Test;
+
+plan 20;
+
+# L<S06/Required parameters/method:>
+sub a_zero () { };
+sub a_one ($a) { };
+sub a_two ($a, $b) { };
+sub a_three ($a, $b, @c) { };
+sub a_four ($a, $b, @c, %d) { };
+
+sub o_zero ($x?, $y?) { };
+sub o_one ($x, :$y) { };
+sub o_two ($x, :$y!, :$z) { };
+
+is &a_zero.arity, 0, '0 arity &sub';
+is &a_one.arity, 1, '1 arity &sub';
+is &a_two.arity, 2, '2 arity &sub';
+is &a_three.arity, 3, '3 arity &sub';
+is &a_four.arity, 4, '4 arity &foo';
+
+is &o_zero.arity, 0, 'arity 0 sub with optional params';
+#?rakudo 2 todo '.arity should not count optional named params'
+is &o_one.arity, 1, 'arity 1 sub with optional params';
+is &o_two.arity, 2, 'arity with optional and required named params';
+
+# It's not really specced in what way (*@slurpy_params) should influence
+# .arity. Also it's unclear what the result of &multisub.arity is.
+# See the thread "&multisub.arity?" on p6l started by Ingo Blechschmidt for
+# details:
+# L<http://thread.gmane.org/gmane.comp.lang.perl.perl6.language/4915>
+
+{
+ is ({ $^a }.arity), 1,
+ "block with one placeholder var has .arity == 1";
+ #?rakudo skip 'pointy block as expression'
+ is (-> $a { $a }.arity), 1,
+ "pointy block with one placeholder var has .arity == 1";
+ #?rakudo skip 'method calling syntax'
+ is arity({ $^a,$^b }:), 2,
+ "block with two placeholder vars has .arity == 2";
+ #?rakudo skip 'pointy block as expression'
+ is arity(-> $a, $b { $a,$b }:), 2,
+ "pointy block with two placeholder vars has .arity == 2";
+ #?rakudo skip 'method calling syntax'
+ is arity({ $^a,$^b,$^c }:), 3,
+ "block with three placeholder vars has .arity == 3";
+ #?rakudo skip 'pointy block as expression'
+ is arity(-> $a, $b, $c { $a,$b,$c }:), 3,
+ "pointy block with three placeholder vars has .arity == 3";
+}
+
+#?rakudo skip 'method calling syntax'
+{
+ is arity({ my $k; $^a }:), 1,
+ "additional my() vars don't influence .arity calculation (1-1)";
+ is arity({ my $k; $^a,$^b }:), 2,
+ "additional my() vars don't influence .arity calculation (1-2)";
+ is arity({ my $k; $^a,$^b,$^c }:), 3,
+ "additional my() vars don't influence .arity calculation (1-3)";
+}
+
+#?rakudo skip 'method calling syntax'
+{
+ is arity({ $^a; my $k }:), 1,
+ "additional my() vars don't influence .arity calculation (2-1)";
+ is arity({ $^a,$^b; my $k }:), 2,
+ "additional my() vars don't influence .arity calculation (2-2)";
+ is arity({ $^a,$^b,$^c; my $k }:), 3,
+ "additional my() vars don't influence .arity calculation (2-3)";
+}
View
@@ -1,7 +1,9 @@
use v6;
use Test;
-plan 10;
+# L<S06/Optional parameters/>
+
+plan 11;
sub opt1($p?) { defined($p) ?? $p !! 'undef'; }
@@ -35,4 +37,9 @@ is opt_typed(2), 2, 'can pass optional typed param';
#?rakudo skip 'optional typed params, RT #61528'
is opt_typed() , 'undef', 'can leave out optional typed param';
+# L<S06/Parameters and arguments/"required positional parameters must come
+# before those bound to optional positional">
+
+eval_dies_ok 'sub wrong ($a?, $b)', 'options params before required ones are forbidden';
+
# vim: ft=perl6
View
@@ -3,7 +3,7 @@ use v6;
use Test;
# L<S12/Classes/"Perl 6 supports multiple inheritance, anonymous classes">
-plan 6;
+plan 10;
# Create and instantiate empty class; check .WHAT works and stringifies to
# empty string.
@@ -23,3 +23,20 @@ is($t2.bar, 28, 'can call methods on anonymous classes');
my $c3 = class { has $.x };
my $t3 = $c3.new(x => 42);
is($t3.x, 42, 'anonymous classes can have attributes');
+
+{
+ my $class;
+ lives_ok { $class = class { method meth() { return 42 } }} ,
+ "anonymous class creation";
+
+ my $a;
+ ok ($a = $class.new), "instantiation of anonymous class";
+ #?rakudo skip '"No execption handler and no message"'
+ is $a.meth, 42, "calling a method on an instance of an anonymous class (1)";
+
+# And the same w/o using a $class variable:
+ #?rakudo skip 'anonymous classes without temp variable'
+ is (class { method meth() { return 42 } }).new.meth, 42,
+ "calling a method on an instance of an anonymous class (2)";
+
+}
View
@@ -0,0 +1,44 @@
+use v6;
+
+use Test;
+
+plan 13;
+
+#?pugs 99 todo 'anonymous roles'
+
+# L<S12/"Roles">
+{
+ my $a = 3;
+ is $a, 3, "basic sanity";
+ lives_ok { $a does role { has $.cool = "yeah" }}, "anonymous role mixin";
+ is $a, 3, "still basic sanity";
+ is $a.cool, "yeah", "anonymous role gave us an attribute";
+}
+
+# The same, but we story the anonymous role in a variable
+{
+ my $a = 3;
+ is $a, 3, "basic sanity";
+ my $role;
+ lives_ok { $role = role { has $.cool = "yeah" } }, "anonymous role definition";
+ lives_ok { $a does $role }, "anonymous role variable mixin";
+ is $a, 3, "still basic sanity";
+ is $a.cool, "yeah", "anonymous role variable gave us an attribute";
+}
+
+# Guarantee roles are really first-class-entities:
+{
+ sub role_generator(Str $val) {
+ return role {
+ has $.cool = $val;
+ }
+ }
+
+ my $a = 3;
+ is $a, 3, "basic sanity";
+ lives_ok {$a does role_generator("hi")}, "role generating function mixin";
+ is $a, 3, "still basic sanity";
+ is $a.cool, "hi", "role generating function gave us an attribute";
+}
+
+# vim: ft=perl6
Oops, something went wrong.

0 comments on commit 288e046

Please sign in to comment.