Refactor one block of code out of function_components_from_declaratio…

…n(). Place in Functions.pm. Test it in 01_functions.t.
parrot · Dec 4, 2010 · 5045bf7 · 5045bf7
1 parent e76c132
commit 5045bf7
Show file tree

Hide file tree

Showing 3 changed files with 59 additions and 10 deletions.
diff --git a/lib/Parrot/Headerizer/Functions.pm b/lib/Parrot/Headerizer/Functions.pm
@@ -12,6 +12,7 @@ our @EXPORT_OK = qw(
     write_file
     qualify_sourcefile
     no_both_PARROT_EXPORT_and_PARROT_INLINE
+    validate_prototype_args
     no_both_static_and_PARROT_EXPORT
     handle_split_declaration
     asserts_from_args
@@ -243,7 +244,26 @@ sub no_both_PARROT_EXPORT_and_PARROT_INLINE {
     my $death =
         "$args->{file} $args->{name}: Can't have both PARROT_EXPORT and PARROT_INLINE";
     die $death if $args->{parrot_inline} && $args->{parrot_api};
-    return;
+    return 1;
+}
+
+=pod
+
+    validate_prototype_args( $args, $proto );
+
+=cut
+
+sub validate_prototype_args {
+    my ($args, $proto) = @_;
+    my @args = split( /\s*,\s*/, $args );
+    for (@args) {
+        /\S+\s+\S+/
+            || ( $_ eq '...' )
+            || ( $_ eq 'void' )
+            || ( $_ =~ /(PARROT|NULLOK|SHIM)_INTERP/ )
+            or die "Bad args in $proto";
+    }
+    return 1;
 }
 
 =pod

diff --git a/lib/Parrot/Headerizer/Object.pm b/lib/Parrot/Headerizer/Object.pm
@@ -35,6 +35,7 @@ use Parrot::Headerizer::Functions qw(
     write_file
     qualify_sourcefile
     no_both_PARROT_EXPORT_and_PARROT_INLINE
+    validate_prototype_args
     no_both_static_and_PARROT_EXPORT
     handle_split_declaration
     asserts_from_args
@@ -312,14 +313,15 @@ sub function_components_from_declaration {
         parrot_api      => $parrot_api,
     } );
 
-    my @args = split( /\s*,\s*/, $args );
-    for (@args) {
-        /\S+\s+\S+/
-            || ( $_ eq '...' )
-            || ( $_ eq 'void' )
-            || ( $_ =~ /(PARROT|NULLOK|SHIM)_INTERP/ )
-            or die "Bad args in $proto";
-    }
+#    my @args = split( /\s*,\s*/, $args );
+#    for (@args) {
+#        /\S+\s+\S+/
+#            || ( $_ eq '...' )
+#            || ( $_ eq 'void' )
+#            || ( $_ =~ /(PARROT|NULLOK|SHIM)_INTERP/ )
+#            or die "Bad args in $proto";
+#    }
+    validate_prototype_args( $args, $proto );
 
     my $is_static;
     ($return_type, $is_static) = no_both_static_and_PARROT_EXPORT( {

diff --git a/t/tools/dev/headerizer/01_functions.t b/t/tools/dev/headerizer/01_functions.t
@@ -20,6 +20,7 @@ use Parrot::Headerizer::Functions qw(
     write_file
     qualify_sourcefile
     no_both_PARROT_EXPORT_and_PARROT_INLINE
+    validate_prototype_args
     no_both_static_and_PARROT_EXPORT
     handle_split_declaration
     asserts_from_args
@@ -34,7 +35,7 @@ use Parrot::Headerizer::Functions qw(
 use IO::CaptureOutput qw| capture |;
 
 my $cwd = cwd();
-my @ofiles;
+my (@ofiles, $rv);
 
 # process_argv()
 eval {
@@ -250,6 +251,7 @@ my ($name, $parrot_inline, $parrot_api);
     ok(! $@, "PARROT_EXPORT and PARROT_INLINE not both true: No 'die' message recorded, as expected" );
 }
 
+# no_both_PARROT_EXPORT_and_PARROT_INLINE
 {
     local $@ = '';
     $filename = 'foobar';
@@ -268,6 +270,31 @@ my ($name, $parrot_inline, $parrot_api);
         "PARROT_EXPORT and PARROT_INLINE  both true: Got expected 'die' message" );
 }
 
+# validate_prototype_args
+my ($args, $proto);
+{
+    local $@ = '';
+    $args = join(' , ' => (
+        'alpha beta',
+        '...',
+        'void',
+        'PARROT_INTERP(interp)',
+        'NULLOK_INTERP(interp)',
+        'SHIM_INTERP',
+    ) );
+    $proto = 'myprototype';
+    $rv = validate_prototype_args( $args, $proto );
+    ok($rv, 'validate_prototype_args() returned true value');
+    ok(! $@, "No error message recorded");
+
+    $args .= ' , single';
+    eval {
+        $rv = validate_prototype_args( $args, $proto );
+    };
+    like($@, qr/Bad args in $proto/,
+        "Detected invalid prototype arg");
+}
+
 # no_both_static_and_PARROT_EXPORT
 my ($return_type_in, $return_type_out, $is_static);
 {