Permalink
Browse files

[t] and [t/spec] (two train travels worth of changes):

 * move arrays/end.t, assuming_and_mmd.t, value_alias_readonly.t, 
   say-crash.t and anchors.t to spec/
 * trig.t: these subs are only available after 'use Num :Trig'
 * s/lives_ok/eval_lives_ok/ for things that happen at compile time
 * Add a whole bunch of smartlinks
 * removed unnecessary eval()s
 * Str.pos is dead, long live 
 * various small cleanups
 * delete xx-uncategorized/return_in_anonymous_subs.t,
   which declared itself obsolete


git-svn-id: http://svn.pugscode.org/pugs@24361 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
1 parent 4a49b41 commit c2f8fec11a850414dd45a1f6c4e6ace817d0a568 moritz committed Dec 14, 2008
@@ -60,3 +60,5 @@ for @nonseparators -> $sep {
#?rakudo emit };
is( @res, [@list.join($sep)], "'\\x$vis' does not split in a whitespace quoted list")
};
+
+# vim: ft=perl6
View
@@ -2,6 +2,8 @@ use v6;
use Test;
+# L<S02/Literals/"There is now a generalized adverbial form of Pair">
+
# See thread "Demagicalizing pair" on p6l started by Luke Palmer,
# L<"http://article.gmane.org/gmane.comp.lang.perl.perl6.language/4778/"> and
# L<"http://colabti.de/irclogger/irclogger_log/perl6?date=2005-10-09,Sun&sel=528#l830">.
@@ -16,7 +18,7 @@ use Test;
#
# my $pair = (a => 42);
# foo($pair); # pair passed positionally
-# foo([,] $pair); # named
+# foo(|$pair); # named
#
# S02 lists ':a' as being equivlaent to a => 1, so
# the type of the value of that pair is Int, not Bool
@@ -0,0 +1,52 @@
+use v6;
+
+use Test;
+
+=begin pod
+
+We ought to be able to change a value when aliasing into it.
+
+=end pod
+
+plan 8;
+
+#?pugs 8 todo 'rw aliasing'
+
+{
+ my %h = 1..4;
+ lives_ok {
+ for %h.values -> $v is rw { $v += 1 }
+ }, 'aliases returned by %hash.values should be rw (1)';
+
+ is %h<3>, 5, 'aliases returned by %hash.values should be rw (2)';
+}
+
+{
+ my @a = 1..4;
+ lives_ok {
+ for @a.values -> $v is rw { $v += 1 }
+ }, 'aliases returned by @array.values should be rw (1)';
+
+ is @a[2], 4, 'aliases returned by @array.values should be rw (2)';
+}
+
+{
+ my $pair = (a => 42);
+ lives_ok {
+ for $pair.value -> $v is rw { $v += 1 }
+ }, 'aliases returned by $pair.values should be rw (1)';
+
+ is $pair.value, 43, 'aliases returned by $pair.values should be rw (2)';
+}
+
+{
+ my $var = 42;
+ my $pair = (a => $var);
+ lives_ok {
+ for $pair.value -> $v is rw { $v += 1 }
+ }, 'aliases returned by $pair.values should be rw (1)';
+
+ is $pair.value, 43, 'aliases returned by $pair.values should be rw (2)';
+}
+
+# (currently this dies with "Can't modify constant item: VInt 2")
View
@@ -48,7 +48,7 @@ ok !defined($/), '$/ still undef in the outer block';
my $count = 0;
my $match = '';;
while $str ~~ /b/ {
- $count++;
+ $count++;
$match = "$/";
$str = '';
}
@@ -68,5 +68,6 @@ ok !defined($/), '$/ still undef in the outer block';
}
# TODO: repeat ... until, gather/take, lambdas, if/unless statement modifiers
+# TODO: move to t/spec/integration/
# vim: ft=perl6
@@ -0,0 +1,47 @@
+use v6;
+
+use Test;
+
+=begin pod
+
+This file was derived from the perl5 CPAN module Perl6::Rules,
+version 0.3 (12 Apr 2004), file t/anchors.t.
+
+It has (hopefully) been, and should continue to be, updated to
+be valid perl6.
+
+L<S05/New metacharacters/"^^ and $$ match line beginnings and endings">
+
+=end pod
+
+plan 19;
+
+if !eval('("a" ~~ /a/)') {
+ skip_rest "skipped tests - rules support appears to be missing";
+} else {
+
+my $str = q{abc
+def
+ghi};
+
+ok( $str ~~ m/^abc/, 'SOS abc' );
+ok(!( $str ~~ m/^bc/ ), 'SOS bc' );
+ok( $str ~~ m/^^abc/, 'SOL abc' );
+ok(!( $str ~~ m/^^bc/ ), 'SOL bc' );
+ok( $str ~~ m/abc\n?$$/, 'abc newline EOL' );
+ok( $str ~~ m/abc$$/, 'abc EOL' );
+ok(!( $str ~~ m/ab$$/ ), 'ab EOL' );
+ok(!( $str ~~ m/abc$/ ), 'abc EOS' );
+ok(!( $str ~~ m/^def/ ), 'SOS def' );
+ok( $str ~~ m/^^def/, 'SOL def' );
+ok( $str ~~ m/def\n?$$/, 'def newline EOL' );
+ok( $str ~~ m/def$$/, 'def EOL' );
+ok(!( $str ~~ m/def$/ ), 'def EOS' );
+ok(!( $str ~~ m/^ghi/ ), 'SOS ghi' );
+ok( $str ~~ m/^^ghi/, 'SOL ghi' );
+ok( $str ~~ m/ghi\n?$$/, 'ghi newline EOL' );
+ok( $str ~~ m/ghi$$/, 'ghi EOL' );
+ok( $str ~~ m/ghi$/, 'ghi EOS' );
+ok( $str ~~ m/^abc$$\n^^d.*f$$\n^^ghi$/, 'All dot' );
+
+}
View
@@ -10,7 +10,7 @@ version 0.3 (12 Apr 2004), file t/newline.t.
plan 15;
-# L<< S05/Changed metacharacters/"C<\n> now matches a logical (platform independent) newline" >>
+# L<S05/Changed metacharacters/"\n now matches a logical (platform independent) newline">
if !eval('("a" ~~ /a/)') {
skip_rest "skipped tests - rules support appears to be missing";
@@ -0,0 +1,18 @@
+use v6;
+
+use Test;
+
+plan 6;
+
+multi testsub (Str $x, $y) { "Str" }
+multi testsub (Int $x, $y) { "Int" }
+
+is testsub("a_str", 42), "Str", "basic MMD works (1)";
+is testsub(23, 42), "Int", "basic MMD works (2)";
+
+is &testsub("a_str", 42), "Str", "basic MMD works with subrefs (1)";
+is &testsub(23, 42), "Int", "basic MMD works with subrefs (2)";
+
+#?pugs todo 'bug'
+is &testsub.assuming(x => "a_str")(42), "Str", "basic MMD works with assuming (1)";
+is &testsub.assuming(x => 23)\ .(42), "Int", "basic MMD works with assuming (2)";
View
@@ -1,6 +1,7 @@
use v6;
use Test;
+# L<S06/Currying/>
plan 3;
sub tester(:$a, :$b, :$c) {
View
@@ -4,6 +4,9 @@ use Test;
plan 17;
+# L<S06/Routine modifiers/>
+# L<S06/Parameters and arguments/>
+
# multi sub with signature
multi sub foo() { "empty" }
multi sub foo($a) { "one" }
@@ -1,7 +1,7 @@
use v6;
use Test;
-plan 8;
+plan 9;
sub xelems(*@args) { @args.elems }
sub xjoin(*@args) { @args.join('|') }
@@ -22,6 +22,7 @@ is mixed(1, 2, 3), '|1|2!3', 'Positional and slurp params';
sub x_typed_join(Int *@args){ @args.join('|') }
is x_typed_join(1), '1', 'Basic slurpy params with types 1';
is x_typed_join(1, 2, 5), '1|2|5', 'Basic slurpy params with types 2';
+ dies_ok { x_typed_join(3, 'x') }, 'Types on slurpy params are checked';
}
# vim: ft=perl6
@@ -3,6 +3,9 @@ use Test;
plan 7;
+# TODO: move to S02?
+# L<S02/Generic types/>
+
# Check it captures built-in types.
sub basic_capture(::T $x) { ~T }
is(basic_capture(42), 'Int', 'captured built-in type');
View
@@ -2,6 +2,7 @@ use v6;
use Test;
+#L<S12/Attributes/"Class attributes are declared">
plan 2;
class Foo {
View
@@ -2,6 +2,7 @@ use v6;
use Test;
+# L<S12/Classes/"Perl 6 supports multiple inheritance, anonymous classes">
plan 6;
# Create and instantiate empty class; check .WHAT works and stringifies to
@@ -4,11 +4,14 @@ use Test;
plan 2;
+
=begin pod
+L<S12/Classes/"bare class names must be predeclared">
A class can only derive already declared classes.
=end pod
-lives_ok { class A {}; class B is A {}; }, "base before derived: lives";
+# need eval_lives_ok here because class declarations happen at compile time
+eval_lives_ok ' class A {}; class B is A {}; ', "base before derived: lives";
eval_dies_ok ' class D is C {}; class C {}; ', "derived before base: dies";
View
@@ -4,6 +4,8 @@ use Test;
plan 35;
+# L<S12/Classes/An "isa" is just a trait that happens to be another class>
+
class Foo {
has $.bar is rw;
has $.value is rw;
View
@@ -4,6 +4,7 @@ use Test;
plan 2;
+# L<S12/Construction and Initialization>
# Basic instantiation.
class Foo1 { };
my $foo1 = Foo1.new();
View
@@ -4,6 +4,9 @@ use Test;
plan 2;
+# L<S12/Classes/"class or type variable using the :: type sigil">
+
+# TODO: move that to t/spec/ as well
BEGIN { @*INC.unshift('t/oo/class/TestFiles'); }
# Testing class literals
@@ -14,6 +14,8 @@ parent attribute initialization
=end description
+# L<S12/Construction and Initialization/>
+
class Foo {
has $.x;
method boo { $.x }
@@ -30,3 +32,5 @@ $u= Bar.new(Foo{ x => 12 });
is($u.boo, 12, 'set parent attribute');
$u.set(9);
is($u.boo, 9, 'reset parent attribute');
+
+# vim: ft=perl6
View
@@ -2,6 +2,8 @@ use v6;
use Test;
plan 4;
+# L<S12/Roles/"Roles may have attributes">
+
role R1 {
has $!a1;
has $.a2 is rw;
View
@@ -2,6 +2,8 @@ use v6;
use Test;
plan 8;
+# L<S12/Roles/"Roles may be composed into a class at compile time">
+
role rA {
method mA1 {
'mA1';
View
@@ -2,6 +2,8 @@ use v6;
use Test;
plan 13;
+# L<S12/Roles/"Run-time mixins are done with does and but">
+
role R1 { method test { 42 } }
class C1 { }
@@ -1,6 +1,8 @@
use v6;
use Test;
+# L<S12/Types and Subtypes/>
+
plan 4;
subset Even of Int where { $_ % 2 == 0 };
View
@@ -0,0 +1,59 @@
+use v6;
+
+use Test;
+
+=begin docs
+
+Array .end tests
+L<S29/Array/=item end>
+=end docs
+
+plan 14;
+
+# basic array .end tests
+
+{ # invocant style
+ my @array = ();
+ is(@array.end, -1, 'we have an empty array');
+
+ @array = (1..43);
+ is(@array.end, 42, 'index of last element is 42 after assignment');
+
+ pop @array;
+ is(@array.end, 41, 'index of last element is 41 after pop');
+
+ shift @array;
+ is(@array.end, 40, 'index of last element is 40 after shift');
+
+ unshift @array, 'foo';
+ is(@array.end, 41, 'index of last element is 41 after unshift');
+
+ push @array, 'bar';
+ is(@array.end, 42, 'index of last element is 42 after push');
+}
+
+{ # non-invocant style
+ my @array = ();
+ is(end(@array), -1, 'we have an empty array');
+
+ @array = (1..43);
+ is(end(@array), 42, 'index of last element is 42 after assignment');
+
+ pop @array;
+ is((end @array), 41, 'index of last element is 41 after pop');
+
+ shift @array;
+ is((end @array), 40, 'index of last element is 40 after shift');
+
+ unshift @array, 'foo';
+ is(end(@array), 41, 'index of last element is 41 after unshift');
+
+ push @array, 'bar';
+ is(end(@array), 42, 'index of last element is 42 after push');
+}
+
+# test some errors
+{
+ dies_ok { end() }, '... end() dies without an argument';
+ dies_ok { 3.end }, '... .end does not work on scalars';
+}
View
@@ -160,3 +160,5 @@ plan 21;
dies_ok { "str".sort :{ 0 } },"method form of sort should not work on strings";
is ~(42,).sort: { 0 }, "42", "method form of sort should work on arrays";
}
+
+# vim: ft=perl6
View
@@ -1,6 +1,7 @@
use v6;
use Test;
+# L<S29/Str/"=item split">
plan 32;
=begin description
Oops, something went wrong.

0 comments on commit c2f8fec

Please sign in to comment.