From: John Peacock <jpeacock@rowman.com>
Date: Mon, 4 Mar 2002 16:18:42 +0000 (-0500)
Subject: [PATCH] enhance xsubpp to support OVERLOAD: keyword
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=54162f5c00ecbf69ece32b5c45c43c32cdb1626c;p=p5sagit%2Fp5-mst-13.2.git

[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
---

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index a12272c..fe2527c 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 ;
diff --git a/pod/perlxs.pod b/pod/perlxs.pod
index 78e3e7c..e5f5f75 100644
--- a/pod/perlxs.pod
+++ b/pod/perlxs.pod
@@ -1214,6 +1214,40 @@ C<BAR::getit()> for this function.
         OUTPUT:
           timep
 
+=head2 The OVERLOAD: Keyword
+
+Instead of writing an overloaded interface using pure Perl, you
+can also use the OVERLOAD keyword to define additional Perl names
+for your functions (like the ALIAS: keyword above).  However, the
+overloaded functions must be defined with three parameters (except
+for the nomethod() function which needs four parameters).  If any
+function has the OVERLOAD: keyword, several additional lines
+will be defined in the c file generated by xsubpp in order to 
+register with the overload magic.
+
+Since blessed objects are actually stored as RV's, it is useful
+to use the typemap features to preprocess parameters and extract
+the actual SV stored within the blessed RV. See the sample for
+T_PTROBJ_SPECIAL below.
+
+To use the OVERLOAD: keyword, create an XS function which takes
+three input parameters ( or use the c style '...' definition) like
+this:
+
+    SV *
+    cmp (lobj, robj, swap)
+    My_Module_obj    lobj
+    My_Module_obj    robj
+    IV               swap
+    OVERLOAD: cmp <=>
+    { /* function defined here */}
+
+In this case, the function will overload both of the three way
+comparison operators.  For all overload operations using non-alpha
+characters, you must type the parameter without quoting, seperating
+multiple overloads with whitespace.  Note that "" (the stringify 
+overload) should be entered as \"\" (i.e. escaped).
+
 =head2 The INTERFACE: Keyword
 
 This keyword declares the current XSUB as a keeper of the given