Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[PATCH] stop "sv_2mortal(&PL_sv_yes)" and "(void)sv_newmortal()" in ParseXS #12661

Closed
p5pRT opened this issue Dec 20, 2012 · 13 comments
Closed

[PATCH] stop "sv_2mortal(&PL_sv_yes)" and "(void)sv_newmortal()" in ParseXS #12661

p5pRT opened this issue Dec 20, 2012 · 13 comments

Comments

@p5pRT
Copy link

@p5pRT p5pRT commented Dec 20, 2012

Migrated from rt.perl.org#116152 (status was 'resolved')

Searchable as RT116152$

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Dec 20, 2012

From @bulk88

Created by @bulk88

Need an RT number. Spam filter killed my last message I think.

Perl Info

Flags:
    category=core
    severity=low

Site configuration information for perl 5.17.7:

Configured by Owner at Sun Dec 16 13:25:34 2012.

Summary of my perl5 (revision 5 version 17 subversion 7 patch blead 
2012-12-06.16:42:20 93a641ae382638ffd1980378be4810244d04f4b0 
v5.17.6-186-g93a641a) configuration:
  Snapshot of: 93a641ae382638ffd1980378be4810244d04f4b0
  Platform:
    osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread
    uname=''
    config_args='undef'
    hint=recommended, useposix=true, d_sigaction=undef
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=undef, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cl', ccflags ='-nologo -GF -W3 -MD -Zi -DNDEBUG -O1 -GL -G7 
-DWIN32 -D_CONSOLE -DNO_STRICT  -DPERL_TEXTMODE_SCRIPTS 
-DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO 
-D_USE_32BIT_TIME_T',
    optimize='-MD -Zi -DNDEBUG -O1 -GL -G7',
    cppflags='-DWIN32'
    ccversion='13.10.6030', gccversion='', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=8
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64', 
lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf 
-ltcg  -libpath:"c:\perl517\lib\CORE"  -machine:x86'
    libpth="C:\Program Files\Microsoft Visual Studio .NET 2003\VC7\lib"
    libs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib  
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib  
netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib  version.lib 
odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
    perllibs=oldnames.lib kernel32.lib user32.lib gdi32.lib 
winspool.lib  comdlg32.lib advapi32.lib shell32.lib ole32.lib 
oleaut32.lib  netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib  
version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
    libc=msvcrt.lib, so=dll, useshrplib=true, libperl=perl517.lib
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
    cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug 
-opt:ref,icf -ltcg  -libpath:"c:\perl517\lib\CORE"  -machine:x86'

Locally applied patches:
    


@INC for perl 5.17.7:
    C:/perl517/site/lib
    C:/perl517/lib
    .


Environment for perl 5.17.7:
    HOME (unset)
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=C:\perl517\bin;C:\Program Files\Microsoft Visual Studio .NET 
2003\Common7\IDE;C:\Program Files\Microsoft Visual Studio .NET 
2003\VC7\BIN;C:\Program Files\Microsoft Visual Studio .NET 
2003\Common7\Tools;C:\Program Files\Microsoft Visual Studio .NET 
2003\Common7\Tools\bin\prerelease;C:\WINDOWS\system32;C:\WINDOWS;C:\WINDOWS\system32\wbem;
    PERL_BADLANG (unset)
    SHELL (unset)


@p5pRT
Copy link
Author

@p5pRT p5pRT commented Dec 20, 2012

From @bulk88

Patch attached.

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Dec 20, 2012

From @bulk88

0001-stop-sv_2mortal-PL_sv_yes-and-void-sv_newmortal-in-P.patch
From 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

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Dec 20, 2012

@bulk88 - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Dec 20, 2012

From @bulk88

On Thu Dec 20 07​:18​:34 2012, bulk88 wrote​:

Patch attached.

CC p5p.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Dec 20, 2012

From @bulk88

On Thu Dec 20 07​:19​:12 2012, bulk88 wrote​:

On Thu Dec 20 07​:18​:34 2012, bulk88 wrote​:

Patch attached.

CC p5p.

This patch also needs a perldelta entry because of the version change. I
didn't do that since I'm using an older Perl.
--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Dec 29, 2012

From @bulk88

On Thu Dec 20 07​:18​:34 2012, bulk88 wrote​:

Patch attached.

bumping
--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Feb 17, 2013

From @cpansprout

On Sat Dec 29 10​:41​:49 2012, bulk88 wrote​:

On Thu Dec 20 07​:18​:34 2012, bulk88 wrote​:

Patch attached.

bumping

I *think* this patch looks OK, but I am not very familiar with ParseXS,
so I don’t feel qualified to review it. Would someone else be able to
have a look?

(Sorry for the delay. I’m two months behind in reading p5p.)

--

Father Chrysostomos

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Mar 13, 2013

From @bulk88

On Sat Dec 29 10​:41​:49 2012, bulk88 wrote​:

On Thu Dec 20 07​:18​:34 2012, bulk88 wrote​:

Patch attached.

bumping

Bumping.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

@p5pRT p5pRT commented May 20, 2013

From @bulk88

On Wed Mar 13 11​:16​:39 2013, bulk88 wrote​:

On Sat Dec 29 10​:41​:49 2012, bulk88 wrote​:

On Thu Dec 20 07​:18​:34 2012, bulk88 wrote​:

Patch attached.

bumping

Bumping.

Bump.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

@p5pRT p5pRT commented May 25, 2013

From @tsee

I munged the supplied patch to apply on top of my smueller/eupxs_ng2
branch and it passes tests. I plan to carefully smoke CPAN against that
branch, which has further changes to ExtUtils​::ParseXS, and then merge it
into blead. So since this patch landing on blead is practically
inevitable, I'm marking this as resolved to avoid forgetting about it
later.

Thanks for persisting!

--Steffen

@p5pRT
Copy link
Author

@p5pRT p5pRT commented May 25, 2013

From [Unknown Contact. See original ticket]

I munged the supplied patch to apply on top of my smueller/eupxs_ng2
branch and it passes tests. I plan to carefully smoke CPAN against that
branch, which has further changes to ExtUtils​::ParseXS, and then merge it
into blead. So since this patch landing on blead is practically
inevitable, I'm marking this as resolved to avoid forgetting about it
later.

Thanks for persisting!

--Steffen

@p5pRT
Copy link
Author

@p5pRT p5pRT commented May 25, 2013

@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
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
1 participant