Fix utils/perldoc.PL for dos-djgpp:

[p5sagit/p5-mst-13.2.git] / vms / gen_shrfls.pl

diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl
index cb4f7dd..807ce59 100644 (file)
--- a/vms/gen_shrfls.pl
+++ b/vms/gen_shrfls.pl
@@ -39,7 +39,7 @@ require 5.000;
 
 $debug = $ENV{'GEN_SHRFLS_DEBUG'};
 
-print "gen_shrfls.pl Rev. 14-Dec-1996\n" if $debug;
+print "gen_shrfls.pl Rev. 03-Nov-1997\n" if $debug;
 
 if ($ARGV[0] eq '-f') {
   open(INP,$ARGV[1]) or die "Can't read input file $ARGV[1]: $!\n";
@@ -145,10 +145,12 @@ sub scan_var {
   my($const) = $line =~ /^EXTCONST/;
 
   print "\tchecking for global variable\n" if $debug > 1;
-  $line =~ s/INIT\(.*\)//;
+  $line =~ s/\s*EXT/EXT/;
+  $line =~ s/INIT\s*\(.*\)//;
   $line =~ s/\[.*//;
   $line =~ s/=.*//;
   $line =~ s/\W*;?\s*$//;
+  $line =~ s/\W*\)\s*\(.*$//; # closing paren for args stripped in previous stmt
   print "\tfiltered to \\$line\\\n" if $debug > 1;
   if ($line =~ /(\w+)$/) {
     print "\tvar name is \\$1\\" . ($const ? ' (const)' : '') . "\n" if $debug > 1;
@@ -156,7 +158,7 @@ sub scan_var {
    else        { $vars{$1}++;  }
   }
   if ($isvaxc) {
-    my($type) = $line =~ /^EXT\w*\s+(\w+)/;
+    my($type) = $line =~ /^\s*EXT\w*\s+(\w+)/;
     print "\tchecking for use of enum (type is \"$type\")\n" if $debug > 2;
     if ($type eq 'expectation') {
       $used_expectation_enum++;
@@ -194,18 +196,18 @@ LINE: while (<CPP>) {
   while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) {
     while (/__VMS_PROTOTYPES__/i .. /__VMS_SEPYTOTORP__/i) {
       print "vms_proto>> $_" if $debug > 2;
-      if (/^EXT/) { &scan_var($_);  }
+      if (/^\s*EXT/) { &scan_var($_);  }
       else        { &scan_func($_); }
       last LINE unless $_ = <CPP>;
     }
     print "vmsish.h>> $_" if $debug > 2;
-    if (/^EXT/) { &scan_var($_); }
+    if (/^\s*EXT/) { &scan_var($_); }
     last LINE unless $_ = <CPP>;
   }    
   while (/^#.*opcode\.h/i .. /^#.*perl\.h/i) {
     print "opcode.h>> $_" if $debug > 2;
     if (/^OP \*\s/) { &scan_func($_); }
-    if (/^EXT/) { &scan_var($_); }
+    if (/^\s*EXT/) { &scan_var($_); }
     if (/^\s+OP_/) { &scan_enum($_); }
     last LINE unless $_ = <CPP>;
   }
@@ -214,14 +216,20 @@ LINE: while (<CPP>) {
     &scan_enum($_);
     last LINE unless $_ = <CPP>;
   }
+  while (/^#.*thread\.h/i .. /^#.*perl\.h/i) {
+    print "thread.h>> $_" if $debug > 2;
+    if (/\s*^EXT/) { &scan_var($_);  }
+    else        { &scan_func($_); }
+    last LINE unless $_ = <CPP>;
+  }
   while (/^#.*proto\.h/i .. /^#.*perl\.h/i) {
     print "proto.h>> $_" if $debug > 2;
-    if (/^EXT/) { &scan_var($_);  }
+    if (/\s*^EXT/) { &scan_var($_);  }
     else        { &scan_func($_); }
     last LINE unless $_ = <CPP>;
   }
   print $_ if $debug > 3 && ($debug > 5 || length($_));
-  if (/^EXT/) { &scan_var($_); }
+  if (/^\s*EXT/) { &scan_var($_); }
 }
 close CPP;
 
@@ -371,7 +379,7 @@ if ($ENV{PERLSHR_USE_GSMATCH}) {
   my $minor = int(($] * 1000 - $major) * 100 + 0.5) & 0xFF;  # range 0..255
   print OPTBLD "GSMATCH=LEQUAL,$major,$minor\n";
   foreach (@symfiles) {
-    print OPTBLD "CLUSTER=\$\$TRANSFER_VECTOR,,,$_.$objsuffix\n";
+    print OPTBLD "CLUSTER=\$\$TRANSFER_VECTOR,,,$_$objsuffix\n";
   }
 }
 elsif (@symfiles) { $incstr .= ',' . join(',',@symfiles); }