add Moose tests and make them pass

diff --git a/MANIFEST b/MANIFEST
index d223f48..5fe040b 100644 (file)
--- 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 (file)
--- 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 (file)
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]');
+}