diff options
author | Nicholas Clark <nick@ccl4.org> | 2012-08-13 13:38:03 +0200 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2012-08-14 10:12:58 +0200 |
commit | c0810f8ef849bf940e296c00ef5a0c1bd77f9c62 (patch) | |
tree | b40d3b48df32447170c20e62a164fba876592210 | |
parent | 43c6d00448d6f91249aa89dd4a28e3d8a17a491f (diff) | |
download | perl-c0810f8ef849bf940e296c00ef5a0c1bd77f9c62.tar.gz |
Use ALIAS to provide XS::APItest::newCONSTSUB and newCONSTSUB_flags
Previously both C routines were wrapped with newCONSTSUB_type, which used a
"type" parameter to determine which C code to call. Use an ALIAS to bind the
code to two names, and eliminate the "type" parameter.
This makes the test code clearer. It's not perfect, as the XS wrapper
XS::APItest::newCONSTSUB has a flags parameter whereas the underlying C code
does not, but fixing this would require considerably more XS hackery.
-rw-r--r-- | ext/XS-APItest/APItest.pm | 2 | ||||
-rw-r--r-- | ext/XS-APItest/APItest.xs | 7 | ||||
-rw-r--r-- | ext/XS-APItest/t/newCONSTSUB.t | 18 |
3 files changed, 14 insertions, 13 deletions
diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index 929bf490a5..a72fb6c443 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp; -our $VERSION = '0.41'; +our $VERSION = '0.42'; require XSLoader; diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 168594844d..dff9b46b2f 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -1957,18 +1957,19 @@ call_method(methname, flags, ...) PUSHs(sv_2mortal(newSViv(i))); void -newCONSTSUB_type(stash, name, flags, type, sv) +newCONSTSUB(stash, name, flags, sv) HV* stash SV* name I32 flags - int type SV* sv + ALIAS: + newCONSTSUB_flags = 1 PREINIT: CV* cv; STRLEN len; const char *pv = SvPV(name, len); PPCODE: - switch (type) { + switch (ix) { case 0: cv = newCONSTSUB(stash, pv, SvOK(sv) ? sv : NULL); break; diff --git a/ext/XS-APItest/t/newCONSTSUB.t b/ext/XS-APItest/t/newCONSTSUB.t index afd44262da..e90cfe0f79 100644 --- a/ext/XS-APItest/t/newCONSTSUB.t +++ b/ext/XS-APItest/t/newCONSTSUB.t @@ -13,34 +13,34 @@ use XS::APItest; my $w; local $SIG{__WARN__} = sub { $w .= shift }; sub frimple() { 78 } - newCONSTSUB_type(\%::, "frimple", 0, 1, undef); + newCONSTSUB_flags(\%::, "frimple", 0, undef); like $w, qr/Constant subroutine frimple redefined at /, 'newCONSTSUB constant redefinition warning is unaffected by $^W=0'; undef $w; - newCONSTSUB_type(\%::, "frimple", 0, 1, undef); + newCONSTSUB_flags(\%::, "frimple", 0, undef); is $w, undef, '...unless the const SVs are the same'; eval 'sub frimple() { 78 }'; undef $w; - newCONSTSUB_type(\%::, "frimple", 0, 1, "78"); + newCONSTSUB_flags(\%::, "frimple", 0, "78"); is $w, undef, '...or the const SVs have the same value'; } use warnings; my ($const, $glob) = - XS::APItest::newCONSTSUB_type(\%::, "sanity_check", 0, 0, undef); + XS::APItest::newCONSTSUB(\%::, "sanity_check", 0, undef); ok $const; ok *{$glob}{CODE}; ($const, $glob) = - XS::APItest::newCONSTSUB_type(\%::, "\x{30cb}", 0, 0, undef); + XS::APItest::newCONSTSUB(\%::, "\x{30cb}", 0, undef); ok $const, "newCONSTSUB generates the constant,"; ok *{$glob}{CODE}, "..and the glob,"; ok !$::{"\x{30cb}"}, "...but not the right one"; ($const, $glob) = - XS::APItest::newCONSTSUB_type(\%::, "\x{30cd}", 0, 1, undef); + XS::APItest::newCONSTSUB_flags(\%::, "\x{30cd}", 0, undef); ok $const, "newCONSTSUB_flags generates the constant,"; ok *{$glob}{CODE}, "..and the glob,"; ok $::{"\x{30cd}"}, "...the right one!"; @@ -51,7 +51,7 @@ eval q{ my $w; local $SIG{__WARN__} = sub { $w .= shift }; *foo = sub(){123}; - newCONSTSUB_type(\%::, "foo", 0, 1, undef); + newCONSTSUB_flags(\%::, "foo", 0, undef); is $w, undef, 'newCONSTSUB uses calling scope for redefinition warnings'; } }; @@ -61,11 +61,11 @@ eval q{ *{"foo::\x{100}"} = sub(){return 123}; my $w; local $SIG{__WARN__} = sub { $w .= shift }; - newCONSTSUB_type(\%foo::, "\x{100}", 0, 1, undef); + newCONSTSUB_flags(\%foo::, "\x{100}", 0, undef); like $w, qr/Subroutine \x{100} redefined at /, 'newCONSTSUB redefinition warning + utf8'; undef $w; - newCONSTSUB_type(\%foo::, "\x{100}", 0, 1, 54); + newCONSTSUB_flags(\%foo::, "\x{100}", 0, 54); like $w, qr/Constant subroutine \x{100} redefined at /, 'newCONSTSUB constant redefinition warning + utf8'; } |