Change 18882 by [EMAIL PROTECTED] on 2003/03/10 17:35:27
Integrate:
[ 17832]
Subject: Re: [PATCH] Correct/completes Overloading in XS mods
From: John Peacock <[EMAIL PROTECTED]>
Date: Sun, 01 Sep 2002 15:00:12 -0400
Message-ID: <[EMAIL PROTECTED]>
[ 18472]
Integrate perlio to mainline:
[ 18240]
Avoid eqtime() wiping the file (as suggested by
"Luis G. Uribe C." <[EMAIL PROTECTED]>
[ 18600]
Retract the %_/SVf change (part of #18456) for PROTOTYPE (CV)
dumping (but now use SvPV_nolen). (This change made an empty
prototype to show up as "_" under -Uuseperlio.)
Affected files ...
... //depot/maint-5.8/perl/dump.c#15 integrate
... //depot/maint-5.8/perl/lib/ExtUtils/Command.pm#2 integrate
... //depot/maint-5.8/perl/lib/ExtUtils/xsubpp#3 integrate
... //depot/maint-5.8/perl/pod/perlxs.pod#2 integrate
Differences ...
==== //depot/maint-5.8/perl/dump.c#15 (text) ====
Index: perl/dump.c
--- perl/dump.c#14~18881~ Mon Mar 10 08:58:22 2003
+++ perl/dump.c Mon Mar 10 09:35:27 2003
@@ -1291,7 +1291,7 @@
break;
case SVt_PVCV:
if (SvPOK(sv))
- Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%"SVf"\"\n", sv);
+ Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n",
SvPV_nolen(sv));
/* FALL THROUGH */
case SVt_PVFM:
do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
==== //depot/maint-5.8/perl/lib/ExtUtils/Command.pm#2 (text) ====
Index: perl/lib/ExtUtils/Command.pm
--- perl/lib/ExtUtils/Command.pm#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/lib/ExtUtils/Command.pm Mon Mar 10 09:35:27 2003
@@ -78,7 +78,7 @@
sub eqtime
{
my ($src,$dst) = @ARGV;
- open(F,">$dst");
+ open(F,">>$dst");
close(F);
utime((stat($src))[8,9],$dst);
}
==== //depot/maint-5.8/perl/lib/ExtUtils/xsubpp#3 (xtext) ====
Index: perl/lib/ExtUtils/xsubpp
--- perl/lib/ExtUtils/xsubpp#2~18271~ Sun Dec 8 18:41:11 2002
+++ perl/lib/ExtUtils/xsubpp Mon Mar 10 09:35:27 2003
@@ -137,6 +137,7 @@
$WantLineNumbers = 1 ;
$WantOptimize = 1 ;
$Overload = 0;
+$Fallback = 'PL_sv_undef';
my $process_inout = 1;
my $process_argtypes = 1;
@@ -293,7 +294,7 @@
$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.
@@ -617,6 +618,24 @@
}
+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
@@ -1065,7 +1084,7 @@
$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);
@@ -1554,6 +1573,25 @@
}
}
+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";
@@ -1592,15 +1630,15 @@
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;
==== //depot/maint-5.8/perl/pod/perlxs.pod#2 (text) ====
Index: perl/pod/perlxs.pod
--- perl/pod/perlxs.pod#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/pod/perlxs.pod Mon Mar 10 09:35:27 2003
@@ -1260,6 +1260,23 @@
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
End of Patch.
