ParseXS: spot MODULE line syntax errors

Previously, a line which was not a completely syntactically correct
MODULE line was not treated as a module line; instead it got passed on
uninterpreted until likely causing an error further along in parsing.

This commit changes things so that anything that looks like the *start*
of a module line is treated as a module line, and is *only then*
examined for full syntactic correctness, giving an error if not ok.

For example: previously, this line:

    MODULE = Foo XXXPACKAGE = Foo::Bar

gave the weird error message:

    Error: Function definition too short 'MODULE = Foo XXXPACKAGE ...

but now gives the error message:

    Error: unparseable MODULE line: 'MODULE = Foo XXXPACKAGE ...

In particular, any line starting with

    /^MODULE\s*[=:]/

is now treated as an attempt to declare a module, including the
syntactically incorrect 'MODULE:' form.

This is in the same spirit that other keywords are already processed;
for example

    PROTOTYPES: XXXENABLE

is treated as as a badly-formed PROTOTYPES line rather than an otherwise
unrecognised and unprocessed line.

Author: iabyn

dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm

@@ -523,8 +523,6 @@ sub _process_module_xs_line {
 
   $self->{PACKAGE_class} = $self->{PACKAGE_name};
   $self->{PACKAGE_class} .= "::" if $self->{PACKAGE_class} ne "";
-
-  $self->{lastline} = "";
 }
 
 
@@ -674,14 +672,24 @@ sub fetch_para {
   my ExtUtils::ParseXS $self = shift;
 
   return 0 if not defined $self->{lastline}; # EOF
+  chomp $self->{lastline}; # may not already have been for first MODULE line
 
   @{ $self->{line} } = ();
   @{ $self->{line_no} } = ();
 
-  if ($self->{lastline} =~
-      /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/)
+  if (ExtUtils::ParseXS::Utilities::looks_like_MODULE_line($self->{lastline}))
   {
+    $self->{lastline} =~
+              /^
+                        MODULE  \s* = \s* ([\w:]+)
+                (?: \s+ PACKAGE \s* = \s* ([\w:]+))?
+                (?: \s+ PREFIX  \s* = \s* (\S+))?
+                \s*
+              $/x
+      or $self->death("Error: unparseable MODULE line: '$self->{lastline}'");
+
     $self->_process_module_xs_line($1, $2, $3);
+    $self->{lastline} = "";
   }
 
   # count how many #ifdef levels we see in this paragraph

dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Node.pm

@@ -370,21 +370,6 @@ sub parse_keywords {
     return @kids;
 }
 
-# return (module, package, prefix) values if the line
-# is a valid 'MODULE = ...' line
-
-sub is_xs_module_line {
-    my __PACKAGE__       $self  = shift;
-    my                   $line  = shift;
-
-    $line =~
-        /^      MODULE  \s* = \s*   [\w:]+
-        (?: \s+ PACKAGE \s* = \s* ( [\w:]+ ) )?
-        (?: \s+ PREFIX  \s* = \s* ( \S+    ) )?
-        \s* $/x;
-}
-
-
 sub as_code { }
 
 # Most node types inherit this: just continue walking the tree
@@ -646,14 +631,15 @@ sub parse {
 
     # Read in lines until the first MODULE line, creating a list of
     # Node::C_part_code and Node::C_part_POD nodes as children.
-    # Returns with $pxs->{lastline} holding the (unprocessed) next line
-    # (or undef for EOF)
+    # Returns with $pxs->{lastline} holding the next line (i.e. the MODULE
+    # line) or errors out if not found
 
     $pxs->{lastline}    =  readline($pxs->{in_fh});
     $pxs->{lastline_no} = $.;
 
     while (defined $pxs->{lastline}) {
-        return 1 if $self->is_xs_module_line($pxs->{lastline});
+        return 1 if ExtUtils::ParseXS::Utilities::looks_like_MODULE_line(
+                                                            $pxs->{lastline});
 
         my $node = 
             $pxs->{lastline} =~ /^=/
@@ -783,7 +769,8 @@ sub parse {
 
     my $cut;
     while (1) {
-        return 1 if $self->is_xs_module_line($pxs->{lastline});
+        return 1 if ExtUtils::ParseXS::Utilities::looks_like_MODULE_line(
+                                                            $pxs->{lastline});
         return 1 if $pxs->{lastline} =~ /^=/;
         push @{$self->{code_lines}}, $pxs->{lastline};
         $pxs->{lastline}    = readline($pxs->{in_fh});

dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm

@@ -25,6 +25,7 @@ our (@ISA, @EXPORT_OK);
   check_conditional_preprocessor_statements
   escape_file_for_line_directive
   report_typemap_failure
+  looks_like_MODULE_line
 );
 
 =head1 NAME
@@ -362,7 +363,11 @@ The current line number.
 
 sub current_line_number {
   my ExtUtils::ParseXS $self = shift;
-  my $line_number = $self->{line_no}->[@{ $self->{line_no} } - @{ $self->{line} } -1];
+  # NB: until the first MODULE line is encountered, $self->{line_no} etc
+  # won't have been populated
+  my $line_number = @{$self->{line_no}}
+        ? $self->{line_no}->[@{ $self->{line_no} } - @{ $self->{line} } -1]
+        : $self->{lastline_no};
   return $line_number;
 }
 
@@ -588,6 +593,27 @@ sub report_typemap_failure {
   return();
 }
 
+=head2 C<looks like_MODULE_line($line)>
+
+Returns true if the passed line looks like an attempt to be a MODULE line.
+Note that it doesn't check for valid syntax. This allows the caller to do
+its own parsing of the line, providing some sort of 'invalid MODULE line'
+check. As compared with thinking that its not a MODULE line if its syntax
+is slightly off, leading instead to some weird error about a bad start to
+an XSUB or something.
+
+In particular, a line starting C<MODULE:> returns true, because it's
+likely to be an attempt by the programmer to write a MODULE line, even
+though it's invalid syntax.
+
+=cut
+
+sub looks_like_MODULE_line {
+  my $line  = shift;
+  $line =~ /^MODULE\s*[=:]/;
+}
+
+
 
 1;
 

dist/ExtUtils-ParseXS/t/001-basic.t

@@ -5701,4 +5701,70 @@ EOF
     test_many($preamble, 'boot_Foo', \@test_fns);
 }
 
+{
+    # Test reporting of bad syntax on MODULE lines.
+
+    my $preamble = Q(<<'EOF');
+EOF
+
+    my @test_fns = (
+        [
+            '1st MODULE PKG',
+            [ Q(<<'EOF') ],
+                |MODULE = X PKG = Y
+                |
+                |PROTOTYPES:  DISABLE
+                |
+EOF
+
+            [ 1, 0, qr{Error: unparseable MODULE line: 'MODULE = X PKG = Y'},
+                "got expected err msg"
+            ],
+        ],
+        [
+            '1st MODULE colon',
+            [ Q(<<'EOF') ],
+                |MODULE: X PACKAGE = Y
+                |
+                |PROTOTYPES:  DISABLE
+                |
+EOF
+
+            [ 1, 0, qr{Error: unparseable MODULE line: 'MODULE: X PACKAGE = Y'},
+                "got expected err msg"
+            ],
+        ],
+        [
+            '2nd MODULE PKG',
+            [ Q(<<'EOF') ],
+                |MODULE = Foo PACKAGE = Foo
+                |
+                |PROTOTYPES:  DISABLE
+                |
+                |MODULE = X PKG = Y
+EOF
+
+            [ 1, 0, qr{Error: unparseable MODULE line: 'MODULE = X PKG = Y'},
+                "got expected err msg"
+            ],
+        ],
+        [
+            '2nd MODULE colon',
+            [ Q(<<'EOF') ],
+                |MODULE = Foo PACKAGE = Foo
+                |
+                |PROTOTYPES:  DISABLE
+                |
+                |MODULE: X PACKAGE = Y
+EOF
+
+            [ 1, 0, qr{Error: unparseable MODULE line: 'MODULE: X PACKAGE = Y'},
+                "got expected err msg"
+            ],
+        ],
+    );
+
+    test_many($preamble, undef, \@test_fns);
+}
+
 done_testing;