Integrate with vmsperl #7430 by Charles Bailey:

[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / xsubpp

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 5a71e89..1e9ff45 100755 (executable)
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -288,7 +288,7 @@ $END = "!End!\n\n";         # "impossible" keyword (multiple newline)
 # Match an XS keyword
 $BLOCK_re= '\s*(' . join('|', qw(
        REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT 
-       CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
+       CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
        SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL
        )) . "|$END)\\s*:";
 
@@ -573,6 +573,15 @@ sub GetAliases
         if $line ;
 }
 
+sub ATTRS_handler ()
+{
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+       next unless /\S/;
+       TrimWhitespace($_) ;
+        push @Attributes, $_;
+    }
+}
+
 sub ALIAS_handler ()
 {
     for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
@@ -847,7 +856,14 @@ EOM
 print("#line 1 \"$filename\"\n")
     if $WantLineNumbers;
 
+firstmodule:
 while (<$FH>) {
+    if (/^=/) {
+       do {
+           next firstmodule if /^=cut\s*$/;
+       } while (<$FH>);
+       &Exit;
+    }
     last if ($Module, $Package, $Prefix) =
        /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
 
@@ -886,6 +902,16 @@ sub fetch_para {
     }
 
     for(;;) {
+       # Skip embedded PODs 
+       while ($lastline =~ /^=/) {
+           while ($lastline = <$FH>) {
+               last if ($lastline =~ /^=cut\s*$/);
+           }
+           death ("Error: Unterminated pod") unless $lastline;
+           $lastline = <$FH>;
+           chomp $lastline;
+           $lastline =~ s/^\s+$//;
+       }
        if ($lastline !~ /^\s*#/ ||
            # CPP directives:
            #   ANSI:   if ifdef ifndef elif else endif define undef
@@ -1039,7 +1065,7 @@ while (fetch_para()) {
        last;
     }
     $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ;
-    %XsubAliases = %XsubAliasValues = %Interfaces = ();
+    %XsubAliases = %XsubAliasValues = %Interfaces = @Attributes = ();
     $DoSetMagic = 1;
 
     $orig_args =~ s/\\\s*/ /g;         # process line continuations
@@ -1210,7 +1236,7 @@ EOF
         $gotRETVAL = 0;
 
        INPUT_handler() ;
-       process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|PROTOTYPE|SCOPE") ;
+       process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|ATTRS|PROTOTYPE|SCOPE") ;
 
        print Q<<"EOF" if $ScopeThisXSUB;
 #   ENTER;
@@ -1252,7 +1278,7 @@ EOF
                }
                print $deferred;
 
-        process_keyword("INIT|ALIAS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ;
+        process_keyword("INIT|ALIAS|ATTRS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ;
 
                if (check_keyword("PPCODE")) {
                        print_section();
@@ -1296,7 +1322,7 @@ EOF
        # $wantRETVAL set if 'RETVAL =' autogenerated
        ($wantRETVAL, $ret_type) = (0, 'void') if $RETVAL_no_return;
        undef %outargs ;
-       process_keyword("POSTCALL|OUTPUT|ALIAS|PROTOTYPE"); 
+       process_keyword("POSTCALL|OUTPUT|ALIAS|ATTRS|PROTOTYPE"); 
 
        # all OUTPUT done, so now push the return value on the stack
        if ($gotRETVAL && $RETVAL_code) {
@@ -1341,7 +1367,7 @@ EOF
        generate_output($var_types{$_}, $num++, $_, 0, 1) for @in_out;
 
        # do cleanup
-       process_keyword("CLEANUP|ALIAS|PROTOTYPE") ;
+       process_keyword("CLEANUP|ALIAS|ATTRS|PROTOTYPE") ;
 
        print Q<<"EOF" if $ScopeThisXSUB;
 #   ]]
@@ -1431,6 +1457,12 @@ EOF
 EOF
         }
     } 
+    elsif (@Attributes) {
+           push(@InitFileCode, Q<<"EOF");
+#        cv = newXS(\"$pname\", XS_$Full_func_name, file);
+#        apply_attrs_string("$Package", cv, "@Attributes", 0);
+EOF
+    }
     elsif ($interface) {
        while ( ($name, $value) = each %Interfaces) {
            $name = "$Package\::$name" unless $name =~ /::/;