diff options
author | Nicholas Clark <nick@ccl4.org> | 2005-01-04 16:20:43 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2005-01-04 16:20:43 +0000 |
commit | 42262798c481d45af93e570836f42d0cd872e008 (patch) | |
tree | f224bf72142bf6cba19224b702242ea06f891c97 | |
parent | 7a4035659c7c5c03891c6a4abd384eaf4aa6753a (diff) | |
download | perl-42262798c481d45af93e570836f42d0cd872e008.tar.gz |
Check all attributes in modify_SV_attributes are recognised.
Fix bug where 'assertion' was always rejected as invalid.
p4raw-id: //depot/perl@23744
-rw-r--r-- | t/op/attrs.t | 36 | ||||
-rw-r--r-- | xsutils.c | 9 |
2 files changed, 41 insertions, 4 deletions
diff --git a/t/op/attrs.t b/t/op/attrs.t index 25abeb21b5..cf4bb44218 100644 --- a/t/op/attrs.t +++ b/t/op/attrs.t @@ -8,13 +8,13 @@ BEGIN { require './test.pl'; } -plan tests => 47; +plan tests => 95; $SIG{__WARN__} = sub { die @_ }; -sub eval_ok ($) { - eval $_[0]; - is( $@, '' ); +sub eval_ok ($;$) { + eval shift; + is( $@, '', @_); } eval_ok 'sub t1 ($) : locked { $_[0]++ }'; @@ -145,3 +145,31 @@ eval 'our ${""} : foo = 1'; like $@, qr/Can't declare scalar dereference in our/; eval 'my $$foo : bar = 1'; like $@, qr/Can't declare scalar dereference in my/; + + +my @code = qw(assertion lvalue locked method); +my @other = qw(shared unique); +my %valid; +$valid{CODE} = {map {$_ => 1} @code}; +$valid{SCALAR} = {map {$_ => 1} @other}; +$valid{ARRAY} = $valid{HASH} = $valid{SCALAR}; + +foreach my $value (\&foo, \$scalar, \@array, \%hash) { + my $type = ref $value; + foreach my $negate ('', '-') { + foreach my $attr (@code, @other) { + my $attribute = $negate . $attr; + eval "use attributes __PACKAGE__, \$value, '$attribute'"; + if ($valid{$type}{$attr}) { + if ($attribute eq '-shared') { + like $@, qr/^A variable may not be unshared/; + } else { + is( $@, '', "$type attribute $attribute"); + } + } else { + like $@, qr/^Invalid $type attribute: $attribute/, + "Bogus $type attribute $attribute should fail"; + } + } + } +} @@ -71,6 +71,15 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) switch (SvTYPE(sv)) { case SVt_PVCV: switch ((int)len) { + case 9: + if (strEQ(name, "assertion")) { + if (negated) + CvFLAGS((CV*)sv) &= ~CVf_ASSERTION; + else + CvFLAGS((CV*)sv) |= CVf_ASSERTION; + continue; + } + break; case 6: switch (*name) { case 'a': |