In perl.git, the branch maint-5.10 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/f3dba27080443db3488db835e838dda26b9de392?hp=5f9e562b69c210cca4f283aac13ba77e9dc3a1d3>
- Log ----------------------------------------------------------------- commit f3dba27080443db3488db835e838dda26b9de392 Author: David Golden <[email protected]> Date: Wed Jul 1 13:54:43 2009 -0400 Updating ExtUtils-ParseXS to 2.20 2.20 - Wed Jul 1 13:42:11 EDT 2009 - No changes from 2.19_04 Signed-off-by: H.Merijn Brand <[email protected]> (cherry picked from commit 55ec0dff636c2a8ee5225314d7d46f928ab7f6da) M Porting/Maintainers.pl M lib/ExtUtils/ParseXS.pm commit 1ab6cfbb18b304a2c4387cbcd291b0dc48e9ab24 Author: David Golden <[email protected]> Date: Mon Jun 29 12:13:31 2009 -0400 Update ExtUtils::ParseXS to 2.19_04 2.19_04 - Mon Jun 29 11:49:12 EDT 2009 - Changed tests to use Test::More and added it to prereqs - Some tests skip if no compiler or if no dynamic loading - INTERFACE keyword tests skipped for perl < 5.8 Signed-off-by: H.Merijn Brand <[email protected]> (cherry picked from commit 6986f47f544756f038968b7387b0c17d74531a13) M Porting/Maintainers.pl M lib/ExtUtils/ParseXS.pm M lib/ExtUtils/ParseXS/t/basic.t M lib/ExtUtils/ParseXS/t/usage.t commit 3290d3a7c571dd60daed0344b2e2a0199fffd316 Author: David Golden <[email protected]> Date: Sun Jun 28 04:17:54 2009 -0400 Update ExtUtils::ParseXS to 2.19_03 2.19_03 - Sat Jun 27 22:51:18 EDT 2009 - Released to see updated results from smoke testers - Fix minor doc typo pulled from blead 2.19_02 - Wed Aug 6 22:18:33 2008 - Fix the usage reports to consistently report package name as well as sub name across ALIAS, INTERFACE and regular XSUBS. [Robert May] - Cleaned up a warning with -Wwrite-strings that gets passed into every parsed XS file. [Steve Peters] - Allow (pedantically correct) C pre-processor comments in the code snippets of typemap files. [Nicholas Clark] Signed-off-by: H.Merijn Brand <[email protected]> (cherry picked from commit 708f9ca6cd5d97c1d91a54a611d88de6e0986ed2) M MANIFEST M Porting/Maintainers.pl M lib/ExtUtils/ParseXS.pm A lib/ExtUtils/ParseXS/t/XSUsage.pm A lib/ExtUtils/ParseXS/t/XSUsage.xs M lib/ExtUtils/ParseXS/t/basic.t A lib/ExtUtils/ParseXS/t/usage.t commit da65c3698d0203815f1adff8b8112ed1bff60d55 Author: Rafael Garcia-Suarez <[email protected]> Date: Wed Jul 1 12:28:04 2009 +0200 Make C<undef ~~ 0> and C<undef ~~ ""> not match (like in 5.10.0) This makes ~~ commutative with regard to undef, and fixes an inconsistency, since C<undef ~~ [0]> was not matching, and ~~ should be distributive in this case. (cherry picked from commit fb51372e8e462d7f3320e8a1b91a913f976aae12) M pod/perlsyn.pod M pp_ctl.c M t/op/smartmatch.t M t/op/switch.t ----------------------------------------------------------------------- Summary of changes: MANIFEST | 3 + Porting/Maintainers.pl | 4 +- lib/ExtUtils/ParseXS.pm | 66 +++++++++--- lib/ExtUtils/ParseXS/t/{XSTest.pm => XSUsage.pm} | 6 +- lib/ExtUtils/ParseXS/t/XSUsage.xs | 37 +++++++ lib/ExtUtils/ParseXS/t/basic.t | 53 ++++++---- lib/ExtUtils/ParseXS/t/usage.t | 125 ++++++++++++++++++++++ pod/perlsyn.pod | 1 + pp_ctl.c | 4 + t/op/smartmatch.t | 14 ++- t/op/switch.t | 16 ++-- 11 files changed, 276 insertions(+), 53 deletions(-) copy lib/ExtUtils/ParseXS/t/{XSTest.pm => XSUsage.pm} (60%) create mode 100644 lib/ExtUtils/ParseXS/t/XSUsage.xs create mode 100644 lib/ExtUtils/ParseXS/t/usage.t diff --git a/MANIFEST b/MANIFEST index 77432cb..033f753 100755 --- a/MANIFEST +++ b/MANIFEST @@ -2186,8 +2186,11 @@ lib/ExtUtils/NOTES Notes about MakeMaker internals lib/ExtUtils/Packlist.pm Manipulates .packlist files lib/ExtUtils/ParseXS.pm converts Perl XS code into C code lib/ExtUtils/ParseXS/t/basic.t See if ExtUtils::ParseXS works +lib/ExtUtils/ParseXS/t/usage.t ExtUtils::ParseXS tests lib/ExtUtils/ParseXS/t/XSTest.pm Test file for ExtUtils::ParseXS tests lib/ExtUtils/ParseXS/t/XSTest.xs Test file for ExtUtils::ParseXS tests +lib/ExtUtils/ParseXS/t/XSUsage.pm ExtUtils::ParseXS tests +lib/ExtUtils/ParseXS/t/XSUsage.xs ExtUtils::ParseXS tests lib/ExtUtils/PATCHING Suggestions for patching MakeMaker lib/ExtUtils/README MakeMaker README lib/ExtUtils/t/00compile.t See if MakeMaker modules compile diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index a754974..2637205 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -731,13 +731,13 @@ package Maintainers; 'ExtUtils::ParseXS' => { 'MAINTAINER' => 'kwilliams', - 'DISTRIBUTION' => 'KWILLIAMS/ExtUtils-ParseXS-2.19.tar.gz', + 'DISTRIBUTION' => 'DAGOLDEN/ExtUtils-ParseXS-2.20.tar.gz', 'FILES' => q[lib/ExtUtils/ParseXS.pm lib/ExtUtils/ParseXS lib/ExtUtils/xsubpp ], 'CPAN' => 1, - 'UPSTREAM' => undef, + 'UPSTREAM' => 'cpan', }, 'faq' => diff --git a/lib/ExtUtils/ParseXS.pm b/lib/ExtUtils/ParseXS.pm index b8ce4a0..9f971d4 100644 --- a/lib/ExtUtils/ParseXS.pm +++ b/lib/ExtUtils/ParseXS.pm @@ -18,7 +18,7 @@ my(@XSStack); # Stack of conditionals and INCLUDEs my($XSS_work_idx, $cpp_next_tmp); use vars qw($VERSION); -$VERSION = '2.19_01'; +$VERSION = '2.20'; use vars qw(%input_expr %output_expr $ProtoUsed @InitFileCode $FH $proto_re $Overload $errors $Fallback $cplusplus $hiertype $WantPrototypes $WantVersionChk $except $WantLineNumbers @@ -305,13 +305,56 @@ EOM exit 0; # Not a fatal error for the caller process } - print <<"EOF"; + print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $WantLineNumbers; + + print <<"EOF"; #ifndef PERL_UNUSED_VAR # define PERL_UNUSED_VAR(var) if (0) var = var #endif EOF + print <<"EOF"; +#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE +#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params) + +/* prototype to pass -Wmissing-prototypes */ +STATIC void +S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params); + +STATIC void +S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params) +{ + const GV *const gv = CvGV(cv); + + PERL_ARGS_ASSERT_CROAK_XS_USAGE; + + if (gv) { + const char *const gvname = GvNAME(gv); + const HV *const stash = GvSTASH(gv); + const char *const hvname = stash ? HvNAME(stash) : NULL; + + if (hvname) + Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params); + else + Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params); + } else { + /* Pants. I don't think that it should be possible to get here. */ + Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params); + } +} +#undef PERL_ARGS_ASSERT_CROAK_XS_USAGE + +#ifdef PERL_IMPLICIT_CONTEXT +#define croak_xs_usage(a,b) S_croak_xs_usage(aTHX_ a,b) +#else +#define croak_xs_usage S_croak_xs_usage +#endif + +#endif + +EOF + print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $WantLineNumbers; $lastline = $_; @@ -597,22 +640,17 @@ EOF # *errbuf = '\0'; EOF - if ($ALIAS) - { print Q(<<"EOF") if $cond } -# if ($cond) -# Perl_croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), "$report_args"); -EOF - else - { print Q(<<"EOF") if $cond } + if($cond) { + print Q(<<"EOF"); # if ($cond) -# Perl_croak(aTHX_ "Usage: %s(%s)", "$pname", "$report_args"); +# croak_xs_usage(cv, "$report_args"); EOF - - # cv doesn't seem to be used, in most cases unless we go in - # the if of this else - print Q(<<"EOF"); + } else { + # cv likely to be unused + print Q(<<"EOF"); # PERL_UNUSED_VAR(cv); /* -W */ EOF + } #gcc -Wall: if an xsub has PPCODE is used #it is possible none of ST, XSRETURN or XSprePUSH macros are used diff --git a/lib/ExtUtils/ParseXS/t/XSTest.pm b/lib/ExtUtils/ParseXS/t/XSUsage.pm similarity index 60% copy from lib/ExtUtils/ParseXS/t/XSTest.pm copy to lib/ExtUtils/ParseXS/t/XSUsage.pm index 988ef47..a375428 100644 --- a/lib/ExtUtils/ParseXS/t/XSTest.pm +++ b/lib/ExtUtils/ParseXS/t/XSUsage.pm @@ -1,8 +1,6 @@ -package XSTest; +package XSUsage; require DynaLoader; @ISA = qw(Exporter DynaLoader); $VERSION = '0.01'; -bootstrap XSTest $VERSION; - -1; +bootstrap XSUsage $VERSION; diff --git a/lib/ExtUtils/ParseXS/t/XSUsage.xs b/lib/ExtUtils/ParseXS/t/XSUsage.xs new file mode 100644 index 0000000..964acd1 --- /dev/null +++ b/lib/ExtUtils/ParseXS/t/XSUsage.xs @@ -0,0 +1,37 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +int xsusage_one() { return 1; } +int xsusage_two() { return 2; } +int xsusage_three() { return 3; } +int xsusage_four() { return 4; } +int xsusage_five() { return 5; } +int xsusage_six() { return 6; } + +MODULE = XSUsage PACKAGE = XSUsage PREFIX = xsusage_ + +PROTOTYPES: DISABLE + +int +xsusage_one() + +int +xsusage_two() + ALIAS: + two_x = 1 + FOO::two = 2 + +int +interface_v_i() + INTERFACE: + xsusage_three + +int +xsusage_four(...) + +int +xsusage_five(int i, ...) + +int +xsusage_six(int i = 0) diff --git a/lib/ExtUtils/ParseXS/t/basic.t b/lib/ExtUtils/ParseXS/t/basic.t index 9b5319e..241ab19 100644 --- a/lib/ExtUtils/ParseXS/t/basic.t +++ b/lib/ExtUtils/ParseXS/t/basic.t @@ -9,12 +9,17 @@ BEGIN { } } use strict; -use Test; -BEGIN { plan tests => 10 }; +use Test::More; +use Config; use DynaLoader; -use ExtUtils::ParseXS qw(process_file); use ExtUtils::CBuilder; -ok(1); # If we made it this far, we're loaded. + +plan tests => 10; + +my ($source_file, $obj_file, $lib_file); + +require_ok( 'ExtUtils::ParseXS' ); +ExtUtils::ParseXS->import('process_file'); chdir 't' or die "Can't chdir to t/, $!"; @@ -25,32 +30,35 @@ use Carp; $SIG{__WARN__} = \&Carp::cluck; # Try sending to filehandle tie *FH, 'Foo'; process_file( filename => 'XSTest.xs', output => \*FH, prototypes => 1 ); -ok tied(*FH)->content, '/is_even/', "Test that output contains some text"; +like tied(*FH)->content, '/is_even/', "Test that output contains some text"; -my $source_file = 'XSTest.c'; +$source_file = 'XSTest.c'; # Try sending to file process_file(filename => 'XSTest.xs', output => $source_file, prototypes => 0); -ok -e $source_file, 1, "Create an output file"; +ok -e $source_file, "Create an output file"; -# TEST doesn't like extraneous output my $quiet = $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE}; - -# Try to compile the file! Don't get too fancy, though. my $b = ExtUtils::CBuilder->new(quiet => $quiet); -if ($b->have_compiler) { - my $module = 'XSTest'; - my $obj_file = $b->compile( source => $source_file ); +SKIP: { + skip "no compiler available", 2 + if ! $b->have_compiler; + $obj_file = $b->compile( source => $source_file ); ok $obj_file; - ok -e $obj_file, 1, "Make sure $obj_file exists"; + ok -e $obj_file, "Make sure $obj_file exists"; +} - my $lib_file = $b->link( objects => $obj_file, module_name => $module ); +SKIP: { + skip "no dynamic loading", 5 + if !$b->have_compiler || !$Config{usedl}; + my $module = 'XSTest'; + $lib_file = $b->link( objects => $obj_file, module_name => $module ); ok $lib_file; - ok -e $lib_file, 1, "Make sure $lib_file exists"; + ok -e $lib_file, "Make sure $lib_file exists"; eval {require XSTest}; - ok $@, ''; + is $@, ''; ok XSTest::is_even(8); ok !XSTest::is_even(9); @@ -64,13 +72,14 @@ if ($b->have_compiler) { } } } - 1 while unlink $obj_file; - 1 while unlink $lib_file; -} else { - skip "Skipped can't find a C compiler & linker", 1 for 1..7; } -1 while unlink $source_file; +unless ($ENV{PERL_NO_CLEANUP}) { + for ( $obj_file, $lib_file, $source_file) { + next unless defined $_; + 1 while unlink $_; + } +} ##################################################################### diff --git a/lib/ExtUtils/ParseXS/t/usage.t b/lib/ExtUtils/ParseXS/t/usage.t new file mode 100644 index 0000000..39a6e41 --- /dev/null +++ b/lib/ExtUtils/ParseXS/t/usage.t @@ -0,0 +1,125 @@ +#!/usr/bin/perl + +BEGIN { + if ($ENV{PERL_CORE}) { + chdir 't' if -d 't'; + chdir '../lib/ExtUtils/ParseXS' + or die "Can't chdir to lib/ExtUtils/ParseXS: $!"; + @INC = qw(../.. ../../.. .); + } +} +use strict; +use Test::More; +use Config; +use DynaLoader; +use ExtUtils::CBuilder; + +if ( $] < 5.008 ) { + plan skip_all => "INTERFACE keyword support broken before 5.8"; +} +else { + plan tests => 24; +} + +my ($source_file, $obj_file, $lib_file, $module); + +require_ok( 'ExtUtils::ParseXS' ); +ExtUtils::ParseXS->import('process_file'); + +chdir 't' or die "Can't chdir to t/, $!"; + +use Carp; $SIG{__WARN__} = \&Carp::cluck; + +######################### + +$source_file = 'XSUsage.c'; + +# Try sending to file +process_file(filename => 'XSUsage.xs', output => $source_file); +ok -e $source_file, "Create an output file"; + +# TEST doesn't like extraneous output +my $quiet = $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE}; + +# Try to compile the file! Don't get too fancy, though. +my $b = ExtUtils::CBuilder->new(quiet => $quiet); + +SKIP: { + skip "no compiler available", 2 + if ! $b->have_compiler; + $module = 'XSUsage'; + + $obj_file = $b->compile( source => $source_file ); + ok $obj_file; + ok -e $obj_file, "Make sure $obj_file exists"; +} +SKIP: { + skip "no dynamic loading", 20 + if !$b->have_compiler || !$Config{usedl}; + + $lib_file = $b->link( objects => $obj_file, module_name => $module ); + ok $lib_file; + ok -e $lib_file, "Make sure $lib_file exists"; + + eval {require XSUsage}; + is $@, ''; + + # The real tests here - for each way of calling the functions, call with the + # wrong number of arguments and check the Usage line is what we expect + + eval { XSUsage::one(1) }; + ok $@; + ok $@ =~ /^Usage: XSUsage::one/; + + eval { XSUsage::two(1) }; + ok $@; + ok $@ =~ /^Usage: XSUsage::two/; + + eval { XSUsage::two_x(1) }; + ok $@; + ok $@ =~ /^Usage: XSUsage::two_x/; + + eval { FOO::two(1) }; + ok $@; + ok $@ =~ /^Usage: FOO::two/; + + eval { XSUsage::three(1) }; + ok $@; + ok $@ =~ /^Usage: XSUsage::three/; + + eval { XSUsage::four(1) }; + ok !$@; + + eval { XSUsage::five() }; + ok $@; + ok $@ =~ /^Usage: XSUsage::five/; + + eval { XSUsage::six() }; + ok !$@; + + eval { XSUsage::six(1) }; + ok !$@; + + eval { XSUsage::six(1,2) }; + ok $@; + ok $@ =~ /^Usage: XSUsage::six/; + + # Win32 needs to close the DLL before it can unlink it, but unfortunately + # dl_unload_file was missing on Win32 prior to perl change #24679! + if ($^O eq 'MSWin32' and defined &DynaLoader::dl_unload_file) { + for (my $i = 0; $i < @DynaLoader::dl_modules; $i++) { + if ($DynaLoader::dl_modules[$i] eq $module) { + DynaLoader::dl_unload_file($DynaLoader::dl_librefs[$i]); + last; + } + } + } +} + +unless ($ENV{PERL_NO_CLEANUP}) { + for ( $obj_file, $lib_file, $source_file) { + next unless defined $_; + 1 while unlink $_; + } +} + diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index 15b3f47..436c6e2 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -702,6 +702,7 @@ and "Array" entries apply in those cases. (For blessed references, the Object Any invokes ~~ overloading on $object, or falls back: Any Num numeric equality $a == $b Num numish[4] numeric equality $a == $b + undef Any undefined !defined($b) Any Any string equality $a eq $b 1 - empty hashes or arrays will match. diff --git a/pp_ctl.c b/pp_ctl.c index 48e158c..f6fda39 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -4378,6 +4378,10 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) SP -= 2; goto sm_any_scalar; } + else if (!SvOK(d)) { + /* undef ~~ scalar ; we already know that the scalar is SvOK */ + RETPUSHNO; + } else sm_any_scalar: if (SvNIOK(e) || (SvPOK(e) && looks_like_number(e) && SvNIOK(d))) { diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t index 58466af..cb0e656 100644 --- a/t/op/smartmatch.t +++ b/t/op/smartmatch.t @@ -70,7 +70,7 @@ my %keyandmore = map { $_ => 0 } @keyandmore; my %fooormore = map { $_ => 0 } @fooormore; # Load and run the tests -plan tests => 314; +plan tests => 322; while (<DATA>) { next if /^#/ || !/\S/; @@ -371,7 +371,7 @@ __DATA__ ["foo", "bar"] [["foo"], ["bar"]] ! ["foo", "bar"] [qr/o/, "foo"] ["foo", undef, "bar"] [qr/o/, undef, "bar"] - ["foo", undef, "bar"] [qr/o/, "", "bar"] +! ["foo", undef, "bar"] [qr/o/, "", "bar"] ! ["foo", "", "bar"] [qr/o/, undef, "bar"] $deep1 $deep1 @$deep1 @$deep1 @@ -409,6 +409,11 @@ __DATA__ ! undef [1, 2, [undef], 4] ! undef @fooormore undef @sparse + undef [undef] +! 0 [undef] +! "" [undef] +! undef [0] +! undef [""] # - nested arrays and ~~ distributivity 11 [[11]] @@ -422,7 +427,8 @@ __DATA__ ! 2 3 0 FALSE 3-2 TRUE - undef 0 +! undef 0 +! (my $u) 0 # Number against string = 2 "2" @@ -430,6 +436,8 @@ __DATA__ ! 2 "2bananas" != 2_3 "2_3" NOWARNINGS FALSE "0" +! undef "0" +! undef "" # Regex against string "x" qr/x/ diff --git a/t/op/switch.t b/t/op/switch.t index bc4dc92..0d08150 100644 --- a/t/op/switch.t +++ b/t/op/switch.t @@ -133,15 +133,15 @@ sub check_outside1 { is($_, "outside", "\$_ lexically scoped") } } { no warnings "uninitialized"; - my $ok = 0; - given (undef) { when(0) {$ok = 1} } + my $ok = 1; + given (undef) { when(0) {$ok = 0} } is($ok, 1, "Given(undef) when(0)"); } { no warnings "uninitialized"; my $undef; - my $ok = 0; - given ($undef) { when(0) {$ok = 1} } + my $ok = 1; + given ($undef) { when(0) {$ok = 0} } is($ok, 1, 'Given($undef) when(0)'); } ######## @@ -158,15 +158,15 @@ sub check_outside1 { is($_, "outside", "\$_ lexically scoped") } } { no warnings "uninitialized"; - my $ok = 0; - given (undef) { when("") {$ok = 1} } + my $ok = 1; + given (undef) { when("") {$ok = 0} } is($ok, 1, 'Given(undef) when("")'); } { no warnings "uninitialized"; my $undef; - my $ok = 0; - given ($undef) { when("") {$ok = 1} } + my $ok = 1; + given ($undef) { when("") {$ok = 0} } is($ok, 1, 'Given($undef) when("")'); } ######## -- Perl5 Master Repository
