From: Vincent Pit Date: Fri, 6 Sep 2013 15:26:36 +0000 (+0200) Subject: Add more basic tests X-Git-Tag: v0.13~15 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FLexical-Types.git;a=commitdiff_plain;h=5373b6a046da88066af5d450a6b7e2d3ffe59d64 Add more basic tests --- diff --git a/t/10-base.t b/t/10-base.t index 282863a..1f7d23d 100644 --- a/t/10-base.t +++ b/t/10-base.t @@ -3,21 +3,207 @@ use strict; use warnings; -use Test::More tests => 4; +use Test::More tests => 2 + 3 * 4 + 5 * 2 + + 2 + 3 * 2 + 5 * 2 + + 2 + 3 * 4 + 5 * 2; -sub Int::TYPEDSCALAR { (caller(0))[2] } +our $calls; + +sub Int::TYPEDSCALAR { ++$calls; (caller(0))[2] } { use Lexical::Types; - my Int $a; - is $a, __LINE__-1, 'single'; + { + my $desc = 'single uninit'; + local $calls = 0; + my Int $x; + is $calls, 1, "$desc: correct number of calls"; + is $x, __LINE__-2, "$desc: initialized correctly"; + } + + { + my $desc = 'double uninit'; + local $calls = 0; + my Int ($x, $y); + is $calls, 2, "$desc: correct number of calls"; + is $x, __LINE__-2, "$desc: initialized \$x correctly"; + is $y, __LINE__-3, "$desc: initialized \$y correctly"; + } + + { + my $desc = 'double uninit with undef begin'; + local $calls = 0; + my Int (undef, $x, $y); + is $calls, 2, "$desc: correct number of calls"; + is $x, __LINE__-2, "$desc: initialized \$x correctly"; + is $y, __LINE__-3, "$desc: initialized \$y correctly"; + } + + { + my $desc = 'double uninit with undef middle'; + local $calls = 0; + my Int ($x, undef, $y); + is $calls, 2, "$desc: correct number of calls"; + is $x, __LINE__-2, "$desc: initialized \$x correctly"; + is $y, __LINE__-3, "$desc: initialized \$y correctly"; + } + + { + my $desc = 'double uninit with undef end'; + local $calls = 0; + my Int ($x, undef, $y); + is $calls, 2, "$desc: correct number of calls"; + is $x, __LINE__-2, "$desc: initialized \$x correctly"; + is $y, __LINE__-3, "$desc: initialized \$y correctly"; + } + + { + my $desc = 'quadruple uninit with parens'; + local $calls = 0; + my Int ($x, ($y, $z), $t); + is $calls, 4, "$desc: correct number of calls"; + is $x, __LINE__-2, "$desc: initialized \$x correctly"; + is $y, __LINE__-3, "$desc: initialized \$y correctly"; + is $z, __LINE__-4, "$desc: initialized \$z correctly"; + is $t, __LINE__-5, "$desc: initialized \$t correctly"; + } + + { + my $desc = 'quadruple uninit with parens and undef'; + local $calls = 0; + my Int ($x, undef, ($y, undef, $z), undef, $t); + is $calls, 4, "$desc: correct number of calls"; + is $x, __LINE__-2, "$desc: initialized \$x correctly"; + is $y, __LINE__-3, "$desc: initialized \$y correctly"; + is $z, __LINE__-4, "$desc: initialized \$z correctly"; + is $t, __LINE__-5, "$desc: initialized \$t correctly"; + } + + { + my $desc = 'single init'; + local $calls = 0; + my Int $x = 'x'; + is $calls, 1, "$desc: correct number of calls"; + is $x, 'x', "$desc: initialized correctly"; + } + + { + my $desc = 'double init'; + local $calls = 0; + my Int ($x, $y) = ('x', 'y'); + is $calls, 2, "$desc: correct number of calls"; + is $x, 'x', "$desc: initialized \$x correctly"; + is $y, 'y', "$desc: initialized \$y correctly"; + } - my Int ($b, $c); - is $b, __LINE__-1, 'double (a)'; - is $c, __LINE__-2, 'double (b)'; + { + my $desc = 'double partial init'; + local $calls = 0; + my Int ($x, undef, $y) = ('x'); + is $calls, 2, "$desc: correct number of calls"; + is $x, 'x', "$desc: initialized \$x correctly"; + is $y, undef, "$desc: initialized \$y correctly"; + } + + { + my $desc = 'quadruple init with parens'; + local $calls = 0; + my Int ($x, ($y, $z), $t) = ('x', 'y'); + is $calls, 4, "$desc: correct number of calls"; + is $x, 'x', "$desc: initialized \$x correctly"; + is $y, 'y', "$desc: initialized \$y correctly"; + is $z, undef, "$desc: initialized \$z correctly"; + is $t, undef, "$desc: initialized \$t correctly"; + } + + { + my $desc = 'quadruple init with parens and undef'; + local $calls = 0; + my Int ($x, ($y, undef, $z), $t) = ('x', 'y'); + is $calls, 4, "$desc: correct number of calls"; + is $x, 'x', "$desc: initialized \$x correctly"; + is $y, 'y', "$desc: initialized \$y correctly"; + is $z, undef, "$desc: initialized \$z correctly"; + is $t, undef, "$desc: initialized \$t correctly"; + } + + { + my $desc = 'for'; + local $calls = 0; + for my Int $x (0) { + is $calls, 0, "$desc: correct number of calls"; + is $x, 0, "$desc: initialized correctly"; + } + } + + { + my $desc = 'argument list'; + local $calls = 0; + sub { + my Int ($x, $y) = @_; + is $calls, 2, "$desc: correct number of calls"; + is $x, 'x', "$desc: initialized \$x correctly"; + is $y, 'y', "$desc: initialized \$y correctly"; + }->('x', 'y'); + } + + { + my $desc = 'argument list with undef begin'; + local $calls = 0; + sub { + my Int (undef, $x, $y) = @_; + is $calls, 2, "$desc: correct number of calls"; + is $x, 'y', "$desc: initialized \$x correctly"; + is $y, undef, "$desc: initialized \$y correctly"; + }->('x', 'y'); + } + + { + my $desc = 'argument list with undef middle'; + local $calls = 0; + sub { + my Int ($x, undef, $y) = @_; + is $calls, 2, "$desc: correct number of calls"; + is $x, 'x', "$desc: initialized \$x correctly"; + is $y, undef, "$desc: initialized \$y correctly"; + }->('x', 'y'); + } + + { + my $desc = 'argument list with undef end'; + local $calls = 0; + sub { + my Int ($x, $y, undef) = @_; + is $calls, 2, "$desc: correct number of calls"; + is $x, 'x', "$desc: initialized \$x correctly"; + is $y, 'y', "$desc: initialized \$y correctly"; + }->('x', 'y'); + } + + { + my $desc = 'argument list with parens'; + local $calls = 0; + sub { + my Int ($x, ($y, $z), $t) = @_; + is $calls, 4, "$desc: correct number of calls"; + is $x, 'x', "$desc: initialized \$x correctly"; + is $y, 'y', "$desc: initialized \$y correctly"; + is $z, 'z', "$desc: initialized \$z correctly"; + is $t, 't', "$desc: initialized \$t correctly"; + }->('x', 'y', 'z', 't'); + } - for my Int $d (0) { - is $d, 0, 'for'; + { + my $desc = 'argument list with parens'; + local $calls = 0; + sub { + my Int ($x, ($y, undef, $z), $t) = @_; + is $calls, 4, "$desc: correct number of calls"; + is $x, 'x', "$desc: initialized \$x correctly"; + is $y, 'y', "$desc: initialized \$y correctly"; + is $z, 'z', "$desc: initialized \$z correctly"; + is $t, undef, "$desc: initialized \$t correctly"; + }->('x', 'y', 'foo', 'z'); } }