This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH] Correct/completes Overloading in XS mods
authorJohn Peacock <jpeacock@rowman.com>
Sun, 1 Sep 2002 15:00:12 +0000 (11:00 -0400)
committerhv <hv@crypt.org>
Wed, 4 Sep 2002 12:39:42 +0000 (12:39 +0000)
Message-ID: <3D7263BC.9020608@rowman.com>

p4raw-id: //depot/perl@17832

lib/ExtUtils/xsubpp
pod/perlxs.pod

index b5dfa61..08df7e3 100755 (executable)
@@ -137,6 +137,7 @@ $ProtoUsed = 0 ;
 $WantLineNumbers = 1 ;
 $WantOptimize = 1 ;
 $Overload = 0;
 $WantLineNumbers = 1 ;
 $WantOptimize = 1 ;
 $Overload = 0;
+$Fallback = 'PL_sv_undef';
 
 my $process_inout = 1;
 my $process_argtypes = 1;
 
 my $process_inout = 1;
 my $process_argtypes = 1;
@@ -293,7 +294,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
 $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 OVERLOAD
+       SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL OVERLOAD FALLBACK
        )) . "|$END)\\s*:";
 
 # Input:  ($_, @line) == unparsed input.
        )) . "|$END)\\s*:";
 
 # Input:  ($_, @line) == unparsed input.
@@ -617,6 +618,24 @@ sub OVERLOAD_handler()
 
 }
 
 
 }
 
+sub FALLBACK_handler()
+{
+    # the rest of the current line should contain either TRUE, 
+    # FALSE or UNDEF
+
+    TrimWhitespace($_) ;
+    my %map = (
+       TRUE => "PL_sv_yes", 1 => "PL_sv_yes",
+       FALSE => "PL_sv_no", 0 => "PL_sv_no",
+       UNDEF => "PL_sv_undef",
+    ) ;
+
+    # check for valid FALLBACK value
+    death ("Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{uc $_} ;
+
+    $Fallback = $map{uc $_} ;
+}
+
 sub REQUIRE_handler ()
 {
     # the rest of the current line should contain a version number
 sub REQUIRE_handler ()
 {
     # the rest of the current line should contain a version number
@@ -1053,7 +1072,7 @@ while (fetch_para()) {
     $xsreturn = 0;
 
     $_ = shift(@line);
     $xsreturn = 0;
 
     $_ = shift(@line);
-    while ($kwd = check_keyword("REQUIRE|PROTOTYPES|VERSIONCHECK|INCLUDE")) {
+    while ($kwd = check_keyword("REQUIRE|PROTOTYPES|FALLBACK|VERSIONCHECK|INCLUDE")) {
         &{"${kwd}_handler"}() ;
         next PARAGRAPH unless @line ;
         $_ = shift(@line);
         &{"${kwd}_handler"}() ;
         next PARAGRAPH unless @line ;
         $_ = shift(@line);
@@ -1542,6 +1561,25 @@ EOF
     }
 }
 
     }
 }
 
+if ($Overload) # make it findable with fetchmethod
+{
+    
+    print Q<<"EOF"; 
+#XS(XS_${Packid}_nil); /* prototype to pass -Wmissing-prototypes */
+#XS(XS_${Packid}_nil)
+#{
+#   XSRETURN_EMPTY;
+#}
+#
+EOF
+    unshift(@InitFileCode, <<"MAKE_FETCHMETHOD_WORK");
+    /* Making a sub named "${Package}::()" allows the package */
+    /* to be findable via fetchmethod(), and causes */
+    /* overload::Overloaded("${Package}") to return true. */
+    newXS("${Package}::()", XS_${Packid}_nil, file$proto);
+MAKE_FETCHMETHOD_WORK
+}
+
 # print initialization routine
 
 print Q<<"EOF";
 # print initialization routine
 
 print Q<<"EOF";
@@ -1580,15 +1618,15 @@ print Q<<"EOF" if defined $XsubAliases or defined $Interfaces ;
 EOF
 
 print Q<<"EOF" if ($Overload);
 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);
-#    }
+#    /* register the overloading (type 'A') magic */
+#    PL_amagic_generation++;
+#    /* The magic for overload gets a GV* via gv_fetchmeth as */
+#    /* mentioned above, and looks in the SV* slot of it for */
+#    /* the "fallback" status. */
+#    sv_setsv(
+#        get_sv( "${Package}::()", TRUE ),
+#        $Fallback
+#    );
 EOF
 
 print @InitFileCode;
 EOF
 
 print @InitFileCode;
index 15a7888..0b66596 100644 (file)
@@ -1260,6 +1260,23 @@ 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).
 
 multiple overloads with whitespace.  Note that "" (the stringify 
 overload) should be entered as \"\" (i.e. escaped).
 
+=head2 The FALLBACK: Keyword
+
+In addition to the OVERLOAD keyword, if you need to control how
+Perl autogenerates missing overloaded operators, you can set the
+FALLBACK keyword in the module header section, like this:
+
+    MODULE = RPC  PACKAGE = RPC
+
+    FALLBACK: TRUE
+    ...
+
+where FALLBACK can take any of the three values TRUE, FALSE, or
+UNDEF.  If you do not set any FALLBACK value when using OVERLOAD,
+it defaults to UNDEF.  FALLBACK is not used except when one or 
+more functions using OVERLOAD have been defined.  Please see
+L<overload/Fallback> for more details.
+
 =head2 The INTERFACE: Keyword
 
 This keyword declares the current XSUB as a keeper of the given
 =head2 The INTERFACE: Keyword
 
 This keyword declares the current XSUB as a keeper of the given