Add -hiertype option to xsubpp for easier mapping C++ with namespaces.
Nick Ing-Simmons [Wed, 3 Apr 2002 06:41:58 +0000 (06:41 +0000)]
p4raw-id: //depot/perlio@15696

lib/ExtUtils/xsubpp

index 284279a..b5dfa61 100755 (executable)
@@ -34,6 +34,10 @@ any makefiles generated by MakeMaker.
 
 Adds ``extern "C"'' to the C code.
 
+=item B<-hiertype>
+
+Retains '::' in type names so that C++ hierachical types can be mapped.
+
 =item B<-except>
 
 Adds exception handling stubs to the C code.
@@ -100,7 +104,7 @@ perl(1), perlxs(1), perlxstut(1)
 
 require 5.002;
 use Cwd;
-use vars '$cplusplus';
+use vars qw($cplusplus $hiertype);
 use vars '%v';
 
 use Config;
@@ -142,6 +146,7 @@ SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
     $flag =~ s/^-// ;
     $spat = quotemeta shift,   next SWITCH     if $flag eq 's';
     $cplusplus = 1,    next SWITCH     if $flag eq 'C++';
+    $hiertype  = 1,    next SWITCH     if $flag eq 'hiertype';
     $WantPrototypes = 0, next SWITCH   if $flag eq 'noprototypes';
     $WantPrototypes = 1, next SWITCH   if $flag eq 'prototypes';
     $WantVersionChk = 0, next SWITCH   if $flag eq 'noversioncheck';
@@ -197,7 +202,7 @@ sub TidyType
 
     # change multiple whitespace into a single space
     s/\s+/ /g ;
-    
+
     # trim leading & trailing whitespace
     TrimWhitespace($_) ;
 
@@ -214,16 +219,16 @@ unshift @tm, qw(../../../../lib/ExtUtils/typemap ../../../lib/ExtUtils/typemap
 foreach $typemap (@tm) {
     next unless -f $typemap ;
     # skip directories, binary files etc.
-    warn("Warning: ignoring non-text typemap file '$typemap'\n"), next 
+    warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
        unless -T $typemap ;
-    open(TYPEMAP, $typemap) 
+    open(TYPEMAP, $typemap)
        or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
     $mode = 'Typemap';
     $junk = "" ;
     $current = \$junk;
     while (<TYPEMAP>) {
        next if /^\s*#/;
-        my $line_no = $. + 1; 
+        my $line_no = $. + 1;
        if (/^INPUT\s*$/)   { $mode = 'Input';   $current = \$junk;  next; }
        if (/^OUTPUT\s*$/)  { $mode = 'Output';  $current = \$junk;  next; }
        if (/^TYPEMAP\s*$/) { $mode = 'Typemap'; $current = \$junk;  next; }
@@ -239,7 +244,7 @@ foreach $typemap (@tm) {
            $type_kind{$type} = $kind ;
             # prototype defaults to '$'
             $proto = "\$" unless $proto ;
-            warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n") 
+            warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n")
                 unless ValidProtoString($proto) ;
             $proto_letter{$type} = C_string($proto) ;
        }
@@ -286,7 +291,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 
+       REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT
        CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
        SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL OVERLOAD
        )) . "|$END)\\s*:";
@@ -359,7 +364,7 @@ if ($WantLineNumbers) {
 sub print_section {
     # the "do" is required for right semantics
     do { $_ = shift(@line) } while !/\S/ && @line;
-    
+
     print("#line ", $line_no[@line_no - @line -1], " \"$filename\"\n")
        if $WantLineNumbers && !/^\s*#\s*line\b/ && !/^#if XSubPPtmp/;
     for (;  defined($_) && !/^$BLOCK_re/o;  $_ = shift(@line)) {
@@ -370,11 +375,11 @@ sub print_section {
 
 sub merge_section {
     my $in = '';
-  
+
     while (!/\S/ && @line) {
         $_ = shift(@line);
     }
-    
+
     for (;  defined($_) && !/^$BLOCK_re/o;  $_ = shift(@line)) {
        $in .= "$_\n";
     }
@@ -387,7 +392,7 @@ sub process_keyword($)
     my($pattern) = @_ ;
     my $kwd ;
 
-    &{"${kwd}_handler"}() 
+    &{"${kwd}_handler"}()
         while $kwd = check_keyword($pattern) ;
 }
 
@@ -403,7 +408,7 @@ sub CASE_handler {
 sub INPUT_handler {
     for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
        last if /^\s*NOT_IMPLEMENTED_YET/;
-       next unless /\S/;       # skip blank lines 
+       next unless /\S/;       # skip blank lines
 
        TrimWhitespace($_) ;
        my $line = $_ ;
@@ -430,7 +435,7 @@ sub INPUT_handler {
 
        # Check for duplicate definitions
        blurt ("Error: duplicate definition of argument '$var_name' ignored"), next
-           if $arg_list{$var_name}++ 
+           if $arg_list{$var_name}++
              or defined $argtype_seen{$var_name} and not $processing_arg_with_types;
 
        $thisdone |= $var_name eq "THIS";
@@ -449,7 +454,7 @@ sub INPUT_handler {
        }
        $var_num = $args_match{$var_name};
 
-        $proto_arg[$var_num] = ProtoString($var_type) 
+        $proto_arg[$var_num] = ProtoString($var_type)
            if $var_num ;
        $func_args =~ s/\b($var_name)\b/&$1/ if $var_addr;
        if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/
@@ -498,21 +503,21 @@ sub OUTPUT_handler {
        } else {
            &generate_output($var_types{$outarg}, $var_num, $outarg, $DoSetMagic);
        }
-       delete $in_out{$outarg}         # No need to auto-OUTPUT 
+       delete $in_out{$outarg}         # No need to auto-OUTPUT
          if exists $in_out{$outarg} and $in_out{$outarg} =~ /OUT$/;
     }
 }
 
 sub C_ARGS_handler() {
     my $in = merge_section();
-  
+
     TrimWhitespace($in);
     $func_args = $in;
-} 
+}
 
 sub INTERFACE_MACRO_handler() {
     my $in = merge_section();
-  
+
     TrimWhitespace($in);
     if ($in =~ /\s/) {         # two
         ($interface_macro, $interface_macro_set) = split ' ', $in;
@@ -526,9 +531,9 @@ sub INTERFACE_MACRO_handler() {
 
 sub INTERFACE_handler() {
     my $in = merge_section();
-  
+
     TrimWhitespace($in);
-    
+
     foreach (split /[\s,]+/, $in) {
         $Interfaces{$_} = $_;
     }
@@ -539,10 +544,10 @@ EOF
     $Interfaces = 1;           # global
 }
 
-sub CLEANUP_handler() { print_section() } 
-sub PREINIT_handler() { print_section() } 
-sub POSTCALL_handler() { print_section() } 
-sub INIT_handler()    { print_section() } 
+sub CLEANUP_handler() { print_section() }
+sub PREINIT_handler() { print_section() }
+sub POSTCALL_handler() { print_section() }
+sub INIT_handler()    { print_section() }
 
 sub GetAliases
 {
@@ -562,7 +567,7 @@ sub GetAliases
 
         # check for optional package definition in the alias
        $alias = $Packprefix . $alias if $alias !~ /::/ ;
-        
+
         # check for duplicate alias name & duplicate value
        Warn("Warning: Ignoring duplicate alias '$orig_alias'")
            if defined $XsubAliases{$alias} ;
@@ -627,30 +632,30 @@ sub REQUIRE_handler ()
        unless $Ver =~ /^\d+(\.\d*)?/ ;
 
     death ("Error: xsubpp $Ver (or better) required--this is only $XSUBPP_version.")
-        unless $XSUBPP_version >= $Ver ; 
+        unless $XSUBPP_version >= $Ver ;
 }
 
 sub VERSIONCHECK_handler ()
 {
     # the rest of the current line should contain either ENABLE or
     # DISABLE
+
     TrimWhitespace($_) ;
+
     # check for ENABLE/DISABLE
     death ("Error: VERSIONCHECK: ENABLE/DISABLE")
         unless /^(ENABLE|DISABLE)/i ;
+
     $WantVersionChk = 1 if $1 eq 'ENABLE' ;
     $WantVersionChk = 0 if $1 eq 'DISABLE' ;
+
 }
 
 sub PROTOTYPE_handler ()
 {
     my $specified ;
 
-    death("Error: Only 1 PROTOTYPE definition allowed per xsub") 
+    death("Error: Only 1 PROTOTYPE definition allowed per xsub")
         if $proto_in_this_xsub ++ ;
 
     for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
@@ -658,10 +663,10 @@ sub PROTOTYPE_handler ()
        $specified = 1 ;
        TrimWhitespace($_) ;
         if ($_ eq 'DISABLE') {
-          $ProtoThisXSUB = 0 
+          $ProtoThisXSUB = 0
         }
         elsif ($_ eq 'ENABLE') {
-          $ProtoThisXSUB = 1 
+          $ProtoThisXSUB = 1
         }
         else {
             # remove any whitespace
@@ -681,17 +686,17 @@ sub PROTOTYPE_handler ()
 
 sub SCOPE_handler ()
 {
-    death("Error: Only 1 SCOPE declaration allowed per xsub") 
+    death("Error: Only 1 SCOPE declaration allowed per xsub")
         if $scope_in_this_xsub ++ ;
 
     for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
                next unless /\S/;
                TrimWhitespace($_) ;
         if ($_ =~ /^DISABLE/i) {
-                  $ScopeThisXSUB = 0 
+                  $ScopeThisXSUB = 0
         }
         elsif ($_ =~ /^ENABLE/i) {
-                  $ScopeThisXSUB = 1 
+                  $ScopeThisXSUB = 1
         }
     }
 
@@ -700,7 +705,7 @@ sub SCOPE_handler ()
 sub PROTOTYPES_handler ()
 {
     # the rest of the current line should contain either ENABLE or
-    # DISABLE 
+    # DISABLE
 
     TrimWhitespace($_) ;
 
@@ -717,9 +722,9 @@ sub PROTOTYPES_handler ()
 sub INCLUDE_handler ()
 {
     # the rest of the current line should contain a valid filename
+
     TrimWhitespace($_) ;
+
     death("INCLUDE: filename missing")
         unless $_ ;
 
@@ -742,12 +747,12 @@ sub INCLUDE_handler ()
         Filename        => $filename,
         Handle          => $FH,
         }) ;
+
     ++ $FH ;
 
     # open the new file
     open ($FH, "$_") or death("Cannot open '$_': $!") ;
+
     print Q<<"EOF" ;
 #
 #/* INCLUDE:  Including '$_' from '$filename' */
@@ -756,7 +761,7 @@ EOF
 
     $filename = $_ ;
 
-    # Prime the pump by reading the first 
+    # Prime the pump by reading the first
     # non-blank line
 
     # skip leading blank lines
@@ -766,9 +771,9 @@ EOF
 
     $lastline = $_ ;
     $lastline_no = $. ;
+
 }
+
 sub PopFile()
 {
     return 0 unless $XSStack[-1]{type} eq 'file' ;
@@ -776,7 +781,7 @@ sub PopFile()
     my $data     = pop @XSStack ;
     my $ThisFile = $filename ;
     my $isPipe   = ($filename =~ /\|\s*$/) ;
+
     -- $IncludedFiles{$filename}
         unless $isPipe ;
 
@@ -864,15 +869,15 @@ open($FH, $filename) or die "cannot open $filename: $!\n";
 # Identify the version of xsubpp used
 print <<EOM ;
 /*
- * This file was generated automatically by xsubpp version $XSUBPP_version from the 
+ * This file was generated automatically by xsubpp version $XSUBPP_version from the
  * contents of $filename. Do not edit this file, edit $filename instead.
  *
- *     ANY CHANGES MADE HERE WILL BE LOST! 
+ *     ANY CHANGES MADE HERE WILL BE LOST!
  *
  */
 
 EOM
+
 
 print("#line 1 \"$filename\"\n")
     if $WantLineNumbers;
@@ -931,7 +936,7 @@ sub fetch_para {
     }
 
     for(;;) {
-       # Skip embedded PODs 
+       # Skip embedded PODs
        while ($lastline =~ /^=/) {
            while ($lastline = <$FH>) {
                last if ($lastline =~ /^=cut\s*$/);
@@ -1243,12 +1248,12 @@ EOF
 #    *errbuf = '\0';
 EOF
 
-    if ($ALIAS) 
+    if ($ALIAS)
       { print Q<<"EOF" if $cond }
 #    if ($cond)
 #       Perl_croak(aTHX_ "Usage: %s($report_args)", GvNAME(CvGV(cv)));
 EOF
-    else 
+    else
       { print Q<<"EOF" if $cond }
 #    if ($cond)
 #      Perl_croak(aTHX_ "Usage: $pname($report_args)");
@@ -1490,18 +1495,18 @@ EOF
         else {
            my $s = ';';
             if ($min_args < $num_args)  {
-                $s = ''; 
+                $s = '';
                $proto_arg[$min_args] .= ";" ;
            }
-            push @proto_arg, "$s\@" 
+            push @proto_arg, "$s\@"
                 if $elipsis ;
-    
+
             $proto = ', "' . join ("", @proto_arg) . '"';
         }
     }
 
     if (%XsubAliases) {
-       $XsubAliases{$pname} = 0 
+       $XsubAliases{$pname} = 0
            unless defined $XsubAliases{$pname} ;
        while ( ($name, $value) = each %XsubAliases) {
            push(@InitFileCode, Q<<"EOF");
@@ -1512,7 +1517,7 @@ EOF
 #        sv_setpv((SV*)cv$proto) ;
 EOF
         }
-    } 
+    }
     elsif (@Attributes) {
            push(@InitFileCode, Q<<"EOF");
 #        cv = newXS(\"$pname\", XS_$Full_func_name, file);
@@ -1606,7 +1611,7 @@ print Q<<"EOF";;
 #
 EOF
 
-warn("Please specify prototyping behavior for $filename (see perlxs manual)\n") 
+warn("Please specify prototyping behavior for $filename (see perlxs manual)\n")
     unless $ProtoUsed ;
 &Exit;
 
@@ -1641,14 +1646,14 @@ sub Warn
 {
     # work out the line number
     my $line_no = $line_no[@line_no - @line -1] ;
+
     print STDERR "@_ in $filename, line $line_no\n" ;
 }
 
-sub blurt 
-{ 
+sub blurt
+{
     Warn @_ ;
-    $errors ++ 
+    $errors ++
 }
 
 sub death
@@ -1665,7 +1670,7 @@ sub generate_init {
     local($tk);
 
     $type = TidyType($type) ;
-    blurt("Error: '$type' not in typemap"), return 
+    blurt("Error: '$type' not in typemap"), return
        unless defined($type_kind{$type});
 
     ($ntype = $type) =~ s/\s*\*/Ptr/g;
@@ -1679,12 +1684,12 @@ sub generate_init {
        if defined $defaults{$var};
       return;
     }
-    $type =~ tr/:/_/;
+    $type =~ tr/:/_/ unless $hiertype;
     blurt("Error: No INPUT definition for type '$type', typekind '$type_kind{$type}' found"), return
         unless defined $input_expr{$tk} ;
     $expr = $input_expr{$tk};
     if ($expr =~ /DO_ARRAY_ELEM/) {
-        blurt("Error: '$subtype' not in typemap"), return 
+        blurt("Error: '$subtype' not in typemap"), return
            unless defined($type_kind{$subtype});
         blurt("Error: No INPUT definition for type '$subtype', typekind '$type_kind{$subtype}' found"), return
             unless defined $input_expr{$type_kind{$subtype}} ;
@@ -1813,7 +1818,8 @@ sub generate_output {
 sub map_type {
     my($type, $varname) = @_;
 
-    $type =~ tr/:/_/;
+    # C++ has :: in types too so skip this
+    $type =~ tr/:/_/ unless $hiertype;
     $type =~ s/^array\(([^,]*),(.*)\).*/$1 */s;
     if ($varname) {
       if ($varname && $type =~ / \( \s* \* (?= \s* \) ) /xg) {