summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2012-08-13 13:38:03 +0200
committerNicholas Clark <nick@ccl4.org>2012-08-14 10:12:58 +0200
commitc0810f8ef849bf940e296c00ef5a0c1bd77f9c62 (patch)
treeb40d3b48df32447170c20e62a164fba876592210 /ext
parent43c6d00448d6f91249aa89dd4a28e3d8a17a491f (diff)
downloadperl-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.
Diffstat (limited to 'ext')
-rw-r--r--ext/XS-APItest/APItest.pm2
-rw-r--r--ext/XS-APItest/APItest.xs7
-rw-r--r--ext/XS-APItest/t/newCONSTSUB.t18
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';
}