From: Lukas Mai Date: Tue, 6 Nov 2012 17:14:34 +0000 (+0100) Subject: add Moose tests and make them pass X-Git-Tag: v1.00_02~7 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a4c13d402a1fdcab88937f6c1db91c399d2ae254;hp=51a483f8759fdd86fd00cdef0c2322be86ad4652;p=p5sagit%2FFunction-Parameters.git add Moose tests and make them pass --- diff --git a/MANIFEST b/MANIFEST index d223f48..5fe040b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -70,6 +70,7 @@ t/invocant.t t/lexical.t t/lineno-torture.t t/lineno.t +t/moose_types.t t/name.t t/name_1.fail t/name_2.fail diff --git a/Parameters.xs b/Parameters.xs index cc3c498..bcff6ab 100644 --- a/Parameters.xs +++ b/Parameters.xs @@ -121,7 +121,9 @@ static void sentinel_clear_void(pTHX_ void *p) { Resource **pp = p; while (*pp) { Resource *cur = *pp; - cur->destroy(aTHX_ cur->data); + if (cur->destroy) { + cur->destroy(aTHX_ cur->data); + } cur->data = (void *)"no"; cur->destroy = NULL; *pp = cur->next; @@ -129,7 +131,7 @@ static void sentinel_clear_void(pTHX_ void *p) { } } -static void sentinel_register(Sentinel sen, void *data, void (*destroy)(pTHX_ void *)) { +static Resource *sentinel_register(Sentinel sen, void *data, void (*destroy)(pTHX_ void *)) { Resource *cur; Newx(cur, 1, Resource); @@ -137,6 +139,12 @@ static void sentinel_register(Sentinel sen, void *data, void (*destroy)(pTHX_ vo cur->destroy = destroy; cur->next = *sen; *sen = cur; + + return cur; +} + +static void sentinel_disarm(Resource *p) { + p->destroy = NULL; } static void my_sv_refcnt_dec_void(pTHX_ void *p) { @@ -812,7 +820,7 @@ static PADOFFSET parse_param( ) { I32 c; char sigil; - SV *name, *typeobj, *typename; + SV *name; assert(!*pinit); *pflags = 0; @@ -824,15 +832,18 @@ static PADOFFSET parse_param( if (c == '(') { I32 floor; OP *expr; + Resource *expr_sentinel; lex_read_unichar(0); - floor = start_subparse(FALSE, CVf_ANON); + floor = start_subparse(FALSE, 0); + SAVEFREESV(PL_compcv); + CvSPECIAL_on(PL_compcv); if (!(expr = parse_fullexpr(PARSE_OPTIONAL))) { croak("In %"SVf": invalid type expression", SVfARG(declarator)); } - sentinel_register(sen, expr, free_op_void); + expr_sentinel = sentinel_register(sen, expr, free_op_void); lex_read_space(0); c = lex_peek_unichar(0); @@ -842,17 +853,19 @@ static PADOFFSET parse_param( lex_read_unichar(0); lex_read_space(0); + SvREFCNT_inc_simple_void(PL_compcv); + sentinel_disarm(expr_sentinel); *ptype = my_eval(aTHX_ sen, floor, expr); + *ptype = reify_type(aTHX_ sen, declarator, *ptype); if (!sv_isobject(*ptype)) { croak("In %"SVf": (%"SVf") doesn't look like a type object", SVfARG(declarator), SVfARG(*ptype)); } c = lex_peek_unichar(0); } else if (my_is_uni_xidfirst(aTHX_ c)) { - typename = parse_type(aTHX_ sen, declarator); + *ptype = parse_type(aTHX_ sen, declarator); my_require(aTHX_ "Moose/Util/TypeConstraints.pm"); - typeobj = reify_type(aTHX_ sen, declarator, typename); - *ptype = typeobj; + *ptype = reify_type(aTHX_ sen, declarator, *ptype); c = lex_peek_unichar(0); } diff --git a/t/moose_types.t b/t/moose_types.t new file mode 100644 index 0000000..1f5344d --- /dev/null +++ b/t/moose_types.t @@ -0,0 +1,131 @@ +#!perl +use warnings FATAL => 'all'; +use strict; + +use Test::More + eval { require Moose; 1 } + ? (tests => 49) + : (skip_all => "Moose required for testing types") +; +use Test::Fatal; + +use Function::Parameters qw(:strict); + +fun foo(Int $n, CodeRef $f, $x) { + $x = $f->($x) for 1 .. $n; + $x +} + +is foo(0, fun {}, undef), undef; +is foo(0, fun {}, "o hai"), "o hai"; +is foo(3, fun ($x) { "($x)" }, 1.5), "(((1.5)))"; +is foo(3, fun (Str $x) { "($x)" }, 1.5), "(((1.5)))"; + +{ + my $info = Function::Parameters::info \&foo; + is $info->invocant, undef; + is $info->slurpy, undef; + is $info->positional_optional, 0; + is $info->named_required, 0; + is $info->named_optional, 0; + my @req = $info->positional_required; + is @req, 3; + is $req[0]->name, '$n'; + ok $req[0]->type->equals('Int'); + is $req[1]->name, '$f'; + ok $req[1]->type->equals('CodeRef'); + is $req[2]->name, '$x'; + is $req[2]->type, undef; +} + +like exception { foo("ermagerd", fun {}, undef) }, qr/\bparameter 1.+\$n\b.+\bValidation failed\b.+\bInt\b.+ermagerd/; +like exception { foo(0, {}, undef) }, qr/\bparameter 2.+\$f\b.+\bValidation failed\b.+\bCodeRef\b/; + +fun bar(((Function::Parameters::info(\&foo)->positional_required)[0]->type) $whoa) { $whoa * 2 } + +is bar(21), 42; +{ + my $info = Function::Parameters::info \&bar; + is $info->invocant, undef; + is $info->slurpy, undef; + is $info->positional_optional, 0; + is $info->named_required, 0; + is $info->named_optional, 0; + my @req = $info->positional_required; + is @req, 1; + is $req[0]->name, '$whoa'; + ok $req[0]->type->equals('Int'); +} + +{ + my $info = Function::Parameters::info(fun ( ArrayRef [ Int | CodeRef ]@nom) {}); + is $info->invocant, undef; + is $info->positional_required, 0; + is $info->positional_optional, 0; + is $info->named_required, 0; + is $info->named_optional, 0; + my $slurpy = $info->slurpy; + is $slurpy->name, '@nom'; + ok $slurpy->type->equals(Moose::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[Int|CodeRef]')); +} + +{ + my $phase = 'runtime'; + BEGIN { $phase = 'A'; } + fun + baz + ( + ( + is + ( + $phase + ++ + , + 'A' + ) + , + 'Int' + ) + : + $marco + , + ( + is + ( + $phase + ++ + , + 'B' + ) + , + q + $ArrayRef[Str]$ + ) + : + $polo + ) + { + [ + $marco + , + $polo + ] + } + BEGIN { is $phase, 'C'; } + is $phase, 'runtime'; + + is_deeply baz(polo => [qw(foo bar baz)], marco => 11), [11, [qw(foo bar baz)]]; + + my $info = Function::Parameters::info \&baz; + is $info->invocant, undef; + is $info->slurpy, undef; + is $info->positional_required, 0; + is $info->positional_optional, 0; + is $info->named_optional, 0; + my @req = $info->named_required; + is @req, 2; + is $req[0]->name, '$marco'; + ok $req[0]->type->equals('Int'); + is $req[1]->name, '$polo'; + ok $req[1]->type->equals('ArrayRef[Str]'); +}