[PATCH] stop "sv_2mortal(&PL_sv_yes)" and "(void)sv_newmortal()" in ParseXS #12661
Labels
Comments
From @bulk88Created by @bulk88Need an RT number. Spam filter killed my last message I think. Perl Info |
From @bulk88Patch attached. |
From @bulk880001-stop-sv_2mortal-PL_sv_yes-and-void-sv_newmortal-in-P.patchFrom 1e4be693f0c891f68dba906ba341c7e7bb0d4a36 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Thu, 20 Dec 2012 10:15:56 -0500
Subject: [PATCH] stop "sv_2mortal(&PL_sv_yes)" and "(void)sv_newmortal()" in
ParseXS
This problem was brought up in #115796. Both of those lines of code that
ParseXS put out when dealing with T_BOOL were unnecessary, and caused a
some inefficiencies (extra calls). Since typemaps can have complicated
evaluation and include Perl code, see commit 9712754a3e, it is best to
eval the typemap entry first, then regexp it to see what it looks like,
not regexp the unevaled entry possibly containing Perl. In case a typemap
entry is maintaining state inside ParseXS (venturing into the undocumented
and unsupported), (I've never seen it done) don't eval it twice if it can
be avoided. Someone might want to change the typemap entry to multiple
eval in the future, but don't introduce it now if it can be avoided.
Using T_BOOL by name to see an immortal is a bad idea, since any XS module
can reuse the typemap entry, so best to regexp for something that looks
like it would return an immortal, "= &PL_sv_* ;" or "= boolSV(". In the
future someone might want to introduce a macro that does nothing, except
gives a signal to ParseXS that an expression returns an immortal or an
already mortaled SV, to suppress the sv_2mortal call.
The tests in 001-basic.t might break in the future with changes to ParseXS
or the Perl API, but I assume they will be fixed at that point in time.
---
dist/ExtUtils-ParseXS/Changes | 3 +
dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm | 25 +++++++----
.../lib/ExtUtils/ParseXS/Constants.pm | 2 +-
.../lib/ExtUtils/ParseXS/CountLines.pm | 2 +-
.../lib/ExtUtils/ParseXS/Utilities.pm | 2 +-
dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm | 2 +-
dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm | 2 +-
.../lib/ExtUtils/Typemaps/InputMap.pm | 2 +-
.../lib/ExtUtils/Typemaps/OutputMap.pm | 2 +-
.../ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm | 2 +-
dist/ExtUtils-ParseXS/t/001-basic.t | 44 +++++++++++++++++++-
dist/ExtUtils-ParseXS/t/typemap | 2 +-
12 files changed, 69 insertions(+), 21 deletions(-)
diff --git a/dist/ExtUtils-ParseXS/Changes b/dist/ExtUtils-ParseXS/Changes
index ae7b40f..bdacad0 100644
--- a/dist/ExtUtils-ParseXS/Changes
+++ b/dist/ExtUtils-ParseXS/Changes
@@ -1,5 +1,8 @@
Revision history for Perl extension ExtUtils::ParseXS.
+ - stop "sv_2mortal(&PL_sv_yes)" and "(void)sv_newmortal()" for immortal
+ typemap entries [perl #116152]
+
3.18 - Mon Nov 19 07:35:00 CET 2012
- Restore portability to Perl 5.6, which was lost at EU-PXS 3.00.
- [perl #112776] avoid warning on an initialized non-parameter
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
index d50b501..6498104 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
@@ -11,7 +11,7 @@ use Symbol;
our $VERSION;
BEGIN {
- $VERSION = '3.18';
+ $VERSION = '3.19';
}
use ExtUtils::ParseXS::Constants $VERSION;
use ExtUtils::ParseXS::CountLines $VERSION;
@@ -1948,19 +1948,25 @@ sub generate_output {
print "\t\tSvSETMAGIC(ST(ix_$var));\n" if $do_setmagic;
}
elsif ($var eq 'RETVAL') {
- if ($expr =~ /^\t\$arg = new/) {
+ my $evalexpr = eval "return qq\a$expr\a";
+ warn $@ if $@;
+ if ($evalexpr =~ /^\t\Q$arg\E = new/) {
# We expect that $arg has refcnt 1, so we need to
# mortalize it.
- eval "print qq\a$expr\a";
- warn $@ if $@;
+ print $evalexpr;
print "\tsv_2mortal(ST($num));\n";
print "\tSvSETMAGIC(ST($num));\n" if $do_setmagic;
}
- elsif ($expr =~ /^\s*\$arg\s*=/) {
+ #if RETVAL is immortal, dont mortal it, this code is not perfect
+ #this won't detect a func or expression that only returns immortals for
+ #example, this RE must be tried must be before next elsif
+ elsif ($evalexpr =~ /^\t\Q$arg\E\s*=\s*(boolSV\(|(&PL_sv_yes|&PL_sv_no|&PL_sv_undef)\s*;)/) {
+ print $evalexpr;
+ }
+ elsif ($evalexpr =~ /^\s*\Q$arg\E\s*=/) {
# We expect that $arg has refcnt >=1, so we need
# to mortalize it!
- eval "print qq\a$expr\a";
- warn $@ if $@;
+ print $evalexpr;
print "\tsv_2mortal(ST(0));\n";
print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic;
}
@@ -1968,10 +1974,9 @@ sub generate_output {
# Just hope that the entry would safely write it
# over an already mortalized value. By
# coincidence, something like $arg = &sv_undef
- # works too.
+ # works too, but should be caught above
print "\tST(0) = sv_newmortal();\n";
- eval "print qq\a$expr\a";
- warn $@ if $@;
+ print $evalexpr;
# new mortals don't have set magic
}
}
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm
index 2e27169..3375b6c 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm
@@ -3,7 +3,7 @@ use strict;
use warnings;
use Symbol;
-our $VERSION = '3.18';
+our $VERSION = '3.19';
=head1 NAME
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm
index 7e2a0f5..fdc3f0b 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm
@@ -1,7 +1,7 @@
package ExtUtils::ParseXS::CountLines;
use strict;
-our $VERSION = '3.18';
+our $VERSION = '3.19';
our $SECTION_END_MARKER;
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
index d0089f8..f4ccd1d 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
@@ -6,7 +6,7 @@ use File::Spec;
use lib qw( lib );
use ExtUtils::ParseXS::Constants ();
-our $VERSION = '3.18';
+our $VERSION = '3.19';
our (@ISA, @EXPORT_OK);
@ISA = qw(Exporter);
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
index 2768ef0..0bec8ca 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps;
use 5.006001;
use strict;
use warnings;
-our $VERSION = '3.18';
+our $VERSION = '3.19';
#use Carp qw(croak);
require ExtUtils::ParseXS;
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm
index 857ac1e..9f199a2 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::Cmd;
use 5.006001;
use strict;
use warnings;
-our $VERSION = '3.18';
+our $VERSION = '3.19';
use ExtUtils::Typemaps;
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm
index 487a4a5..d83752b 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::InputMap;
use 5.006001;
use strict;
use warnings;
-our $VERSION = '3.18';
+our $VERSION = '3.19';
=head1 NAME
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm
index 0896061..18e5a70 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::OutputMap;
use 5.006001;
use strict;
use warnings;
-our $VERSION = '3.18';
+our $VERSION = '3.19';
=head1 NAME
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm
index 1b9f8ba..6410e45 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
require ExtUtils::Typemaps;
-our $VERSION = '3.18';
+our $VERSION = '3.19';
=head1 NAME
diff --git a/dist/ExtUtils-ParseXS/t/001-basic.t b/dist/ExtUtils-ParseXS/t/001-basic.t
index f948768..0060581 100644
--- a/dist/ExtUtils-ParseXS/t/001-basic.t
+++ b/dist/ExtUtils-ParseXS/t/001-basic.t
@@ -1,7 +1,7 @@
#!/usr/bin/perl
use strict;
-use Test::More tests => 11;
+use Test::More tests => 14;
use Config;
use DynaLoader;
use ExtUtils::CBuilder;
@@ -72,8 +72,48 @@ open my $IN, '<', $source_file
while (my $l = <$IN>) {
$seen++ if $l =~ m/#line\s1\s/;
}
+is( $seen, 1, "Linenumbers created in output file, as intended" );
+{
+ #rewind .c file and regexp it to look for code generation problems
+ local $/ = undef;
+ seek($IN, 0, 0);
+ my $filecontents = <$IN>;
+ my $good_T_BOOL_re =
+qr|\QXS_EUPXS(XS_XSTest_T_BOOL)\E
+.+?
+#line \d+\Q "XSTest.c"
+ ST(0) = boolSV(RETVAL);
+ }
+ XSRETURN(1);
+}
+\E|s;
+ like($filecontents, $good_T_BOOL_re, 'T_BOOL doesn\'t have an extra sv_newmortal or sv_2mortal');
+
+ my $good_T_BOOL_2_re =
+qr|\QXS_EUPXS(XS_XSTest_T_BOOL_2)\E
+.+?
+#line \d+\Q "XSTest.c"
+ sv_setsv(ST(0), boolSV(in));
+ SvSETMAGIC(ST(0));
+ }
+ XSRETURN(1);
+}
+\E|s;
+ like($filecontents, $good_T_BOOL_2_re, 'T_BOOL_2 doesn\'t have an extra sv_newmortal or sv_2mortal');
+ my $good_T_BOOL_OUT_re =
+qr|\QXS_EUPXS(XS_XSTest_T_BOOL_OUT)\E
+.+?
+#line \d+\Q "XSTest.c"
+ sv_setsv(ST(0), boolSV(out));
+ SvSETMAGIC(ST(0));
+ }
+ XSRETURN_EMPTY;
+}
+\E|s;
+ like($filecontents, $good_T_BOOL_OUT_re, 'T_BOOL_OUT doesn\'t have an extra sv_newmortal or sv_2mortal');
+
+}
close $IN or die "Unable to close $source_file: $!";
-is( $seen, 1, "Linenumbers created in output file, as intended" );
unless ($ENV{PERL_NO_CLEANUP}) {
for ( $obj_file, $lib_file, $source_file) {
diff --git a/dist/ExtUtils-ParseXS/t/typemap b/dist/ExtUtils-ParseXS/t/typemap
index 2c35437..85c8309 100644
--- a/dist/ExtUtils-ParseXS/t/typemap
+++ b/dist/ExtUtils-ParseXS/t/typemap
@@ -240,7 +240,7 @@ T_SYSRET
T_ENUM
sv_setiv($arg, (IV)$var);
T_BOOL
- $arg = boolSV($var);
+ ${"$var" eq "RETVAL" ? \"$arg = boolSV($var);" : \"sv_setsv($arg, boolSV($var));"}
T_U_INT
sv_setuv($arg, (UV)$var);
T_SHORT
--
1.7.9.msysgit.0
|
|
@bulk88 - Status changed from 'new' to 'open' |
From @bulk88On Thu Dec 20 07:18:34 2012, bulk88 wrote:
CC p5p. -- |
From @bulk88On Thu Dec 20 07:19:12 2012, bulk88 wrote:
This patch also needs a perldelta entry because of the version change. I |
From @bulk88On Thu Dec 20 07:18:34 2012, bulk88 wrote:
bumping |
From @cpansproutOn Sat Dec 29 10:41:49 2012, bulk88 wrote:
I *think* this patch looks OK, but I am not very familiar with ParseXS, (Sorry for the delay. I’m two months behind in reading p5p.) -- Father Chrysostomos |
From @bulk88On Sat Dec 29 10:41:49 2012, bulk88 wrote:
Bumping. -- |
From @bulk88On Wed Mar 13 11:16:39 2013, bulk88 wrote:
Bump. -- |
From @tseeI munged the supplied patch to apply on top of my smueller/eupxs_ng2 Thanks for persisting! --Steffen |
From [Unknown Contact. See original ticket]I munged the supplied patch to apply on top of my smueller/eupxs_ng2 Thanks for persisting! --Steffen |
|
@tsee - Status changed from 'open' to 'resolved' |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Migrated from rt.perl.org#116152 (status was 'resolved')
Searchable as RT116152$
The text was updated successfully, but these errors were encountered: