[PATCH] enhance xsubpp to support OVERLOAD: keyword

Date: Mon, 04 Mar 2002 16:18:42 -0500
Message-ID: <3C83E4B2.3060700@rowman.com>

Subject: Re: [PATCH] enhance xsubpp to support OVERLOAD: keyword
From: John Peacock <jpeacock@rowman.com>
Date: Mon, 04 Mar 2002 16:42:55 -0500
Message-ID: <3C83EA5F.80303@rowman.com>

p4raw-id: //depot/perl@15017

1 files changed, 33 insertions, 5 deletions

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index a12272cf80..fe2527c2dc 100755
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -132,6 +132,7 @@ $WantVersionChk = 1 ;
 $ProtoUsed = 0 ;
 $WantLineNumbers = 1 ;
 $WantOptimize = 1 ;
+$Overload = 0;
 
 my $process_inout = 1;
 my $process_argtypes = 1;
@@ -287,7 +288,7 @@ $END = "!End!\n\n";		# "impossible" keyword (multiple newline)
 $BLOCK_re= '\s*(' . join('|', qw(
 	REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT 
 	CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
-	SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL
+	SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL OVERLOAD
 	)) . "|$END)\\s*:";
 
 # Input:  ($_, @line) == unparsed input.
@@ -596,6 +597,21 @@ sub ALIAS_handler ()
     }
 }
 
+sub OVERLOAD_handler()
+{
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+	next unless /\S/;
+	TrimWhitespace($_) ;
+        while ( s/^\s*([\w:"\\)\+\-\*\/\%\<\>\.\&\|\^\!\~\{\}]+)\s*//) {
+	    $Overload = 1 unless $Overload;
+	    my $overload = "$Package\::(".$1 ;
+            push(@InitFileCode,
+    	     "        newXS(\"$overload\", XS_$Full_func_name, file$proto);\n");
+        }
+    }
+
+}
+
 sub REQUIRE_handler ()
 {
     # the rest of the current line should contain a version number
@@ -1273,7 +1289,7 @@ EOF
         $gotRETVAL = 0;
 
 	INPUT_handler() ;
-	process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|ATTRS|PROTOTYPE|SCOPE") ;
+	process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|ATTRS|PROTOTYPE|SCOPE|OVERLOAD") ;
 
 	print Q<<"EOF" if $ScopeThisXSUB;
 #   ENTER;
@@ -1315,7 +1331,7 @@ EOF
 		}
 		print $deferred;
 
-        process_keyword("INIT|ALIAS|ATTRS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ;
+        process_keyword("INIT|ALIAS|ATTRS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS|OVERLOAD") ;
 
 		if (check_keyword("PPCODE")) {
 			print_section();
@@ -1359,7 +1375,7 @@ EOF
 	# $wantRETVAL set if 'RETVAL =' autogenerated
 	($wantRETVAL, $ret_type) = (0, 'void') if $RETVAL_no_return;
 	undef %outargs ;
-	process_keyword("POSTCALL|OUTPUT|ALIAS|ATTRS|PROTOTYPE"); 
+	process_keyword("POSTCALL|OUTPUT|ALIAS|ATTRS|PROTOTYPE|OVERLOAD");
 
 	&generate_output($var_types{$_}, $args_match{$_}, $_, $DoSetMagic)
 	  for grep $in_out{$_} =~ /OUT$/, keys %in_out;
@@ -1407,7 +1423,7 @@ EOF
 	generate_output($var_types{$_}, $num++, $_, 0, 1) for @outlist;
 
 	# do cleanup
-	process_keyword("CLEANUP|ALIAS|ATTRS|PROTOTYPE") ;
+	process_keyword("CLEANUP|ALIAS|ATTRS|PROTOTYPE|OVERLOAD") ;
 
 	print Q<<"EOF" if $ScopeThisXSUB;
 #   ]]
@@ -1558,6 +1574,18 @@ print Q<<"EOF" if defined $XsubAliases or defined $Interfaces ;
 #
 EOF
 
+print Q<<"EOF" if ($Overload);
+#    {
+#        /* create the package stash */
+#        HV *hv = get_hv(\"$Package\::OVERLOAD\",TRUE);
+#        SV *sv = *hv_fetch(hv,"register",8,1);
+#        sv_inc(sv);
+#        SvSETMAGIC(sv);
+#        /* Make it findable via fetchmethod */
+#        newXS(\"$Package\::()\", NULL, file);
+#    }
+EOF
+
 print @InitFileCode;
 
 print Q<<"EOF" if defined $XsubAliases or defined $Interfaces ;