Changeset 22514

Show
Ignore:
Timestamp:
10/05/08 19:32:08 (7 weeks ago)
Author:
moritz
Message:

[t] move some tests to spec/, re-worked pre-post.t, some minor corrections and
rakudo fudgings

Location:
t
Files:
1 removed
3 modified
4 moved

Legend:

Unmodified
Added
Removed

  • t/blocks/closure.t

    r22399 r22514  
    55 
    66diag "Testing for calling block bindings..."; 
    7 ok eval(q[ 
     7is eval(q[ 
    88        my &foo := { "foo" }; 
    99        foo; 
    10 ]), "Calling block binding without argument. (Runtime)"; 
     10]), 'foo',  "Calling block binding without argument. (Runtime)"; 
    1111 
    12 ok eval(q[ 
     12is eval(q[ 
    1313        my &foo ::= { "foo" }; 
    1414        foo; 
    15 ]), "Calling block binding without argument. (Compile-time)"; 
     15]), 'foo',  "Calling block binding without argument. (Compile-time)"; 
    1616 
    17 ok eval(q[ 
     17is eval(q[ 
    1818        my &foo := { $^a }; 
    1919        foo(1); 
    20 ]), "Calling block binding with argument. (Runtime, with parens)"; 
     20]), 1, "Calling block binding with argument. (Runtime, with parens)"; 
    2121 
    22 ok eval(q[ 
     22is eval(q[ 
    2323        my &foo := { $^a }; 
    2424        foo 1; 
    25 ]), "Calling block binding with argument. (Runtime, no parens)"; 
     25]), 1,  "Calling block binding with argument. (Runtime, no parens)"; 
    2626 
    27 ok eval(q[ 
     27is eval(q[ 
    2828        my &foo ::= { $^a }; 
    2929        foo(1); 
    30 ]), "Calling block binding with argument. (Compile-time, with parens)"; 
     30]), 1,  "Calling block binding with argument. (Compile-time, with parens)"; 
    3131 
    32 ok eval(q[ 
     32is eval(q[ 
    3333        my &foo ::= { $^a }; 
    3434        foo 1; 
    35 ]), "Calling block binding with argument. (Compile-time, no parens)"; 
     35]), 1,  "Calling block binding with argument. (Compile-time, no parens)"; 
    3636 
    3737 

  • t/closure_traits/in_loop.t

    r20490 r22514  
    88# 
    99# * KEEP, UNDO, PRE, POST, CONTROL 
    10 #   CATCH is tested in t/base/try.t 
     10#   CATCH is tested in t/spec/S04-statements/try.t 
    1111# 
    1212# * $var will undo, etc 

  • t/spec/S04-closure-traits/next.

    r20490 r22514  
    88#   "end of the loop block" or "explicit next"> 
    99{ 
    10     my $str; 
     10    my $str = ''; 
    1111    for 1..5 { 
    1212        NEXT { $str ~= ':' } 
    … …  
    1919# NEXT is positioned at the bottom: 
    2020{ 
    21     my $str; 
     21    my $str = ''; 
    2222    for 1..5 { 
    2323        next if $_ % 2 == 1; 
    … …  
    3030# NEXT is positioned in the middle: 
    3131{ 
    32     my $str; 
     32    my $str = ''; 
    3333    for 1..5 { 
    3434        next if $_ % 2 == 1; 
    … …  
    4141# NEXT is evaluated even at the last iteration 
    4242{ 
    43     my $str; 
     43    my $str = ''; 
    4444    for 1..2 { 
    4545        NEXT { $str ~= 'n'; } 
    … …  
    5353 
    5454{ 
    55     my $str; 
     55    my $str = ''; 
    5656    try { 
    5757        for 1..5 { 
    … …  
    6464 
    6565{ 
    66     my $str; 
     66    my $str = ''; 
    6767    try { 
    6868        for 1..5 { 
    … …  
    7575 
    7676{ 
    77     my $str; 
     77    my $str = ''; 
    7878    my sub foo { 
    7979        for 1..5 { 
    … …  
    8888# L<S04/Closure traits/last bypasses "NEXT blocks"> 
    8989{ 
    90     my $str; 
     90    my $str = ''; 
    9191    for 1..5 { 
    9292        NEXT { $str ~= $_; } 
    … …  
    9999 
    100100{ 
    101     my $str; 
     101    my $str = ''; 
    102102    for 1..2 { 
    103103        NEXT { $str ~= 'n' } 
    … …  
    109109# reversed order 
    110110{ 
    111     my $str; 
     111    my $str = ''; 
    112112    for 1..2 { 
    113113        LEAVE { $str ~= 'l' } 
    … …  
    122122 
    123123{ 
    124     my $str; 
     124    my $str = ''; 
    125125    my $n = 0; 
    126126    my $i; 
    … …  
    134134 
    135135{ 
    136     my $str; 
     136    my $str = ''; 
    137137    loop (my $n = 0; $n < 5; ++$n) { 
    138138       NEXT { $str ~= $n } 
    … …  
    143143{ 
    144144    my @x = 0..4; 
    145     my $str; 
     145    my $str = ''; 
    146146    for @x { 
    147147        NEXT { $str ~= $_; } 

  • t/spec/S04-closure-traits/pre-post.t

    r22195 r22514  
    99# TODO:  
    1010#  * Multiple inheritance + PRE/POST blocks 
    11 #  * check that the POST block receives the return value as topic ($_) 
    1211 
    13 plan 16; 
     12plan 18; 
    1413 
    15 my $foo = ' 
    1614sub foo(Num $i) { 
    1715    PRE { 
    … …  
    2018    return 1; 
    2119} 
    22 '; 
    2320 
    24 sub bar(int $i) { 
     21sub bar(Int $i) { 
    2522    return 1; 
    2623    POST { 
    … …  
    2926} 
    3027 
    31 ok eval($foo ~ 'foo(2);'), 'sub with PRE compiles and runs'; 
    32 ok eval(bar(3)), 'sub with POST compiles'; 
     28lives_ok { foo(2) }, 'sub with PRE compiles and runs'; 
     29lives_ok { bar(3) }, 'sub with POST compiles and runs'; 
    3330 
    34 try { 
    35     eval($foo ~ 'foo(10)'); 
    36 } 
    37  
    38 ok defined($!), 'Violated PRE fails OK'; 
    39  
    40 try { 
    41     bar(10); 
    42 } 
    43 ok defined($!), 'violated POST fails OK'; 
     31dies_ok { foo(10) }, 'Violated PRE  throws (catchable) exception'; 
     32dies_ok { bar(10) }, 'Violated POST throws (catchable) exception'; 
    4433 
    4534# multiple PREs und POSTs 
    4635 
    47 my $baz = ' 
    4836sub baz (Num $i) { 
    4937        PRE { 
    … …  
    5543        return 1; 
    5644} 
    57 '; 
    58 ok($baz ~ 'baz(2)', 'sub with two PREs compiles and runs'); 
     45lives_ok { baz(2) }, 'sub with two PREs compiles and runs'; 
    5946 
    60 eval( $baz ~ 'baz(-1)'); 
    61 ok(defined($!), 'sub with two PREs fails when first is violated'); 
     47dies_ok  { baz(-1)}, 'sub with two PREs fails when first is violated'; 
     48dies_ok  { baz(42)}, 'sub with two PREs fails when second is violated'); 
    6249 
    63 eval( $baz ~ 'baz(42)'); 
    64 ok(defined($!), 'sub with two PREs fails when second is violated'); 
    6550 
    6651sub qox (Num $i) { 
    … …  
    7459} 
    7560 
    76 ok(qox(23), "sub with two POSTs compiles and runs"); 
    77  
    78 try { 
    79         qox(-1); 
    80 } 
    81  
    82 ok(defined($!), "sub with two POSTs fails if first POST is violated"); 
    83  
    84 try { 
    85         qox(123); 
    86 } 
    87  
    88 ok(defined($!), "sub with two POSTs fails if second POST is violated"); 
     61lives_ok({ qox(23) }, "sub with two POSTs compiles and runs"); 
     62dies_ok( { qox(-1) }, "sub with two POSTs fails if first POST is violated"); 
     63dies_ok( { qox(123)}, "sub with two POSTs fails if second POST is violated"); 
    8964 
    9065# inheritance 
    9166 
    92 my $ih_pre =  
    93 ' class Foo { 
     67class PRE_Parent { 
    9468    method test(Num $i) { 
    9569        PRE { 
    96             $i > 23 
     70            $i < 23 
    9771        } 
    98                  
    9972        return 1; 
    10073    } 
    10174} 
    10275 
    103 class Bar is Foo { 
     76class PRE_Child is PRE_Parent { 
    10477    method test(Num $i){ 
    10578        PRE { 
    106             $i < -23 
     79            $i > 0; 
    10780        } 
    10881        return 1; 
    10982    } 
    11083} 
    111 my $foo = Bar.new; '; 
    11284 
    113 ok(eval($ih_pre ~ '$foo.test(-42)'), "PRE in methods compiles and runs"); 
    114 ok(eval($ih_pre ~ '$foo.test(42)'), "inherited PRE in compiles and runs"); 
     85my $foo = PRE_Child.new; 
    11586 
    116 try { 
    117     eval($ih_pre ~ '$foo.test(0)'); 
    118 } 
    119  
    120 ok(defined($!), "violated PRE in methods fails OK"); 
     87lives_ok { $foo.test(5)    }, 'PRE in methods compiles and runs'; 
     88dies_ok  { $foo.test(-42)  }, 'PRE in child throws'; 
     89dies_ok  { $foo.test(78)   }, 'PRE in parent throws'; 
    12190 
    12291 
    123 class Foo { 
     92class POST_Parent { 
    12493    method test(Num $i) { 
    12594        return 1; 
    12695        POST { 
    127             $i < 23 
     96            $i > 23 
    12897        } 
    12998    } 
    13099} 
    131100 
    132 class Bar is Foo { 
     101class POST_Child is POST_Parent { 
    133102    method test(Num $i){ 
    134103        return 1; 
    135104        POST { 
    136             $i > -23 
     105            $i < -23 
    137106        } 
    138107    } 
    139108} 
    140 my $foo_post = Bar.new; 
     109my $mp = POST_Child.new; 
    141110 
    142 ok(eval('$foo_post.test(0)'), "Inherited POST compiles and runs"); 
     111lives_ok  { $mp.test(-42) }, "It's enough if we satisfy one of the POST blocks (Child)"; 
     112lives_ok  { $mp.test(42)  }, "It's enough if we satisfy one of the POST blocks (Parent)"; 
     113dies_ok   { $tmp.test(12) }, 'Violating poth POST blocks throws an error'; 
    143114 
    144 try { 
    145     $foo_post.test(42); 
     115class Another { 
     116    method test(Num $x) { 
     117        return 3 * $x; 
     118        POST { 
     119            $_ > 4 
     120        } 
     121    } 
    146122} 
    147 ok(defined($!), "Inherited POST fails ok"); 
    148123 
    149 try { 
    150     $foo_post.test(-42); 
    151 } 
    152 ok(defined($!), "Own POST fails ok"); 
     124my $pt = Another.new; 
     125lives_ok { $pt.test(2) }, 'POST receives return value as $_ (succeess)'; 
     126dies_ok  { $pt.test(1) }, 'POST receives return value as $_ (failure)'; 

  • t/spec/S06-signature/sub-ref.t

    r21997 r22514  
    2727{ 
    2828    my $foo = sub () { 42 }; 
    29     isa_ok($foo, 'Code'); 
    30     isa_ok($foo, 'Routine'); 
    31     isa_ok($foo, 'Sub'); 
     29    isa_ok($foo, Code); 
     30    #?rakudo 2 todo 'types Sub, Routine' 
     31    isa_ok($foo, Routine); 
     32    isa_ok($foo, Sub); 
    3233    is $foo.(), 42,                 "basic invocation of an anonymous sub"; 
    33     try { $foo.(23) }; 
    34     ok($!, "invocation of an parameterless anonymous sub with a parameter dies"); 
     34    #?rakudo todo 'signature error checking' 
     35    dies_ok { $foo.(23) }, "invocation of an parameterless anonymous sub with a parameter dies"; 
    3536} 
    3637 
     38#?rakudo skip 'pointy blocks' 
    3739{ 
    3840    my $foo = -> { 42 }; 
    39     isa_ok($foo, 'Code'); 
    40     isa_ok($foo, 'Block'); 
     41    isa_ok($foo, Code); 
     42    isa_ok($foo, Block); 
    4143    is $foo.(), 42,                 "basic invocation of a pointy block"; 
    42     try { $foo.(23) }; 
    43     ok($!, "invocation of an parameterless pointy block with a parameter dies"); 
     44    dies_ok { $foo.(23) },  "invocation of an parameterless pointy block with a parameter dies"; 
    4445} 
    4546 
    … …  
    4950    isa_ok($foo, 'Block'); 
    5051    is $foo.(42), 142,              "basic invocation of a pointy block with a param"; 
    51     try { $foo.() }; 
    52     ok($!, "invocation of an parameterized block expecting a param without a param dies"); 
     52    dies_ok { $foo.() }, "invocation of an parameterized block expecting a param without a param dies"; 
    5353} 
    5454 
    5555{ 
    5656    my $foo = sub { 100 + (@_[0] // -1) }; 
    57     isa_ok($foo, 'Code'); 
    58     isa_ok($foo, 'Routine'); 
    59     isa_ok($foo, 'Sub'); 
     57    isa_ok($foo, Code); 
     58    #?rakudo 2 todo 'types Sub, Routine' 
     59    isa_ok($foo, Routine); 
     60    isa_ok($foo, Sub); 
    6061    is $foo.(42), 142,              "basic invocation of a perl5-like anonymous sub (1)"; 
    6162    is $foo.(),    99,              "basic invocation of a perl5-like anonymous sub (2)"; 
    … …  
    6465{ 
    6566    my $foo = sub ($x) { 100 + $x }; 
    66     isa_ok($foo, 'Code'); 
    67     isa_ok($foo, 'Routine'); 
    68     isa_ok($foo, 'Sub'); 
     67    isa_ok($foo, Code); 
     68    #?rakudo 2 todo 'types Sub, Routine' 
     69    isa_ok($foo, Routine); 
     70    isa_ok($foo, Sub); 
    6971    is $foo.(42),      142,    "calling an anonymous sub with a positional param"; 
     72    #?rakudo skip 'calling positiona parameters by name' 
    7073    is $foo.(x => 42), 142,    "calling an anonymous sub with a positional param addressed by name"; 
    7174    dies_ok { $foo.() },  
    … …  
    7780# Confirmed by p6l, see thread "Anonymous macros?" by Ingo Blechschmidt 
    7881# L<"http://www.nntp.perl.org/group/perl.perl6.language/21825"> 
     82#?rakudo skip 'macros, compile time binding' 
    7983{ 
    8084    # We do all this in a eval() not because the code doesn't parse, 
    … …  
    8690    # think.) 
    8791    our &foo_macro ::= macro ($x) { "1000 + $x" }; 
    88     isa_ok(&foo_macro, "Code"); 
    89     isa_ok(&foo_macro, "Routine"); 
    90     isa_ok(&foo_macro, "Macro", :todo<feature>); 
     92    isa_ok(&foo_macro, Code); 
     93    isa_ok(&foo_macro, Routine); 
     94    #?pugs todo 'macros' 
     95    isa_ok(&foo_macro, Macro); 
    9196 
    9297    is foo_macro(3), 1003, "anonymous macro worked"; 
    9398} 
    9499 
     100#?rakudo skip 'scoping/closures' 
    95101{ 
    96102    my $mkinc = sub { my $x = 0; return sub { $x++ }; }; 
    … …  
    99105    my $inc2 = $mkinc(); 
    100106 
    101     is($inc1(), 0, "inc1 == 0"); 
    102     is($inc1(), 1, "inc1 == 1"); 
    103     is($inc2(), 0, "inc2 == 0"); 
    104     is($inc2(), 1, "inc2 == 1"); 
     107    is($inc1(), 0, "clousures: inc1 == 0"); 
     108    is($inc1(), 1, "clousures: inc1 == 1"); 
     109    is($inc2(), 0, "clousures: inc2 == 0"); 
     110    is($inc2(), 1, "clousures: inc2 == 1"); 
    105111}