This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove compile-time checking of rv2?v with const kid
authorFather Chrysostomos <sprout@cpan.org>
Mon, 25 Aug 2014 05:12:52 +0000 (22:12 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 25 Aug 2014 05:49:19 +0000 (22:49 -0700)
There was code in op.c:ck_rvconst (which runs when creating a derefer-
ence op, such as rv2sv, rv2av, etc.) that would check that a constant
kid holding a reference pointed to something of the right type.  It
failed to take overloading into account.

The result was that these lines would fail to compile:

    constant_reference_to_hash_with_coderef_overloading->();
    constant_reference_to_sub_with_hashref_overloading->{key};
    constant_reference_to_sub_with_arrayref_overloading->[0];
    constant_reference_to_sub_with_scalarref_overloading->$*;

even though they should work.

Since the overloadedness could change any time, even checking for that
in op.c is incorrect.  The only correct fix is to remove this compile-
time check.  If something naughty gets through, it will be caught
at run time.

This fixes bugs #122607 and #69456.

dist/constant/t/constant.t
lib/overload.t
op.c

index 111a8e1..159e217 100644 (file)
@@ -122,7 +122,7 @@ print $output CCODE->($curr_test+4);
 $TB->current_test($curr_test+4);
 
 eval q{ CCODE->{foo} };
-ok scalar($@ =~ /^Constant is not a HASH/);
+ok scalar($@ =~ /^Constant is not a HASH|Not a HASH reference/);
 
 
 # Allow leading underscore
index d89ec2a..2371c71 100644 (file)
@@ -48,7 +48,7 @@ package main;
 
 $| = 1;
 BEGIN { require './test.pl' }
-plan tests => 5194;
+plan tests => 5198;
 
 use Scalar::Util qw(tainted);
 
@@ -2730,6 +2730,23 @@ EOF
     pass("RT 121362");
 }
 
+package refsgalore {
+    use overload
+       '${}' => sub { \42  },
+       '@{}' => sub { [43] },
+       '%{}' => sub { { 44 => 45 } },
+       '&{}' => sub { sub { 46 } };
+}
+{
+    use feature 'postderef';
+    no warnings 'experimental::postderef';
+    tell myio; # vivifies *myio{IO} at compile time
+    use constant ioref => bless *myio{IO}, refsgalore::;
+    is ioref->$*, 42, '(overloaded constant that is not a scalar ref)->$*';
+    is ioref->[0], 43, '(ovrld constant that is not an array ref)->[0]';
+    is ioref->{44}, 45, "(ovrld const that is not a hash ref)->{key}";
+    is ioref->(), 46, '(overloaded constant that is not a sub ref)->()';
+}
 
 { # undefining the overload stash -- KEEP THIS TEST LAST
     package ant;
diff --git a/op.c b/op.c
index 2bc03ae..ff3855e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -8834,30 +8834,6 @@ Perl_ck_rvconst(pTHX_ OP *o)
 
        /* Is it a constant from cv_const_sv()? */
        if (SvROK(kidsv) && SvREADONLY(kidsv)) {
-           SV * const rsv = SvRV(kidsv);
-           const svtype type = SvTYPE(rsv);
-            const char *badtype = NULL;
-
-           switch (o->op_type) {
-           case OP_RV2SV:
-               if (type > SVt_PVMG)
-                   badtype = "a SCALAR";
-               break;
-           case OP_RV2AV:
-               if (type != SVt_PVAV)
-                   badtype = "an ARRAY";
-               break;
-           case OP_RV2HV:
-               if (type != SVt_PVHV)
-                   badtype = "a HASH";
-               break;
-           case OP_RV2CV:
-               if (type != SVt_PVCV)
-                   badtype = "a CODE";
-               break;
-           }
-           if (badtype)
-               Perl_croak(aTHX_ "Constant is not %s reference", badtype);
            return o;
        }
        if (SvTYPE(kidsv) == SVt_PVAV) return o;