search

Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.91k stars 542 forks source link

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

Closed p5pRT closed 11 years ago

p5pRT commented 11 years ago

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

Searchable as RT116152$

p5pRT commented 11 years ago

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 commented 11 years ago

From @bulk88

Patch attached.

p5pRT commented 11 years ago

From @bulk88

0001-stop-sv_2mortal-PL_sv_yes-and-void-sv_newmortal-in-P.patch ```diff From 1e4be693f0c891f68dba906ba341c7e7bb0d4a36 Mon Sep 17 00:00:00 2001 From: Daniel Dragan 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 commented 11 years ago

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

p5pRT commented 11 years ago

From @bulk88

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

Patch attached.

CC p5p.

-- bulk88 ~ bulk88 at hotmail.com

p5pRT commented 11 years ago

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 commented 11 years ago

From @bulk88

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

Patch attached.

bumping -- bulk88 ~ bulk88 at hotmail.com

p5pRT commented 11 years ago

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 commented 11 years ago

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 commented 11 years ago

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 commented 11 years ago

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 commented 11 years ago

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 commented 11 years ago

@tsee - Status changed from 'open' to 'resolved'