From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 12 May 2012 20:03:54 +0000 (-0700)
Subject: Make pos(@array) and pos(%hash) into errors
X-Git-Tag: upstream/5.20.0~6819
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=32a609747bffb70bd058b030c9fab6ff44c329e4;p=platform%2Fupstream%2Fperl.git

Make pos(@array) and pos(%hash) into errors

Currently pos has an effective prototype of (;\[$@%*]), and what it
does is rather interesting.

First, it produces a strange uninitialized warning:

$ ./perl -Ilib -we 'pos my @a = 3'
Use of uninitialized value within @a in scalar assignment at -e line 1.

There is no uninitialized value here.  The value ‘within @a’ is actu-
ally @a itself.  The code that produces the error message was written
under the (perfectly logical) assumption that an array would never be
passed to report_uninit().

Secondly, it adds pos magic to the array itself:

$ ./perl -Ilib -e 'pos @a = 3; use Devel::Peek; Dump \@a'
SV = IV(0x8039fc) at 0x803a00
  REFCNT = 1
  FLAGS = (TEMP,ROK)
  RV = 0x825b90
  SV = PVAV(0x804a04) at 0x825b90
    REFCNT = 2
    FLAGS = (SMG)
    MAGIC = 0x30cb20
      MG_VIRTUAL = &PL_vtbl_mglob
      MG_TYPE = PERL_MAGIC_regex_global(g)
    ARRAY = 0x0
    FILL = -1
    MAX = -1
    ARYLEN = 0x0
    FLAGS = (REAL)

This magic can never be used, as @a =~ /foo/g is equivalent to
scalar(@a) =~ /foo/g, and scalar(@a) returns a scalar containing the
length of the array, not the array itself.

This seems clearly a mistake.

pos forces lvalue context on its argument, making pos(3) a compile-
time error.

Internally, the main distinction between \$ (scalar lvalue) and
\[$@%*] (scalar lvalue, or some other type) prototypes is that the
function S_scalar_mod_type returns true for functions with the former,
but false for functions with the latter.  (Tangentially, \[$@%*] and
\[$@%&*] are distinguished by the special-casing in op_lvalue_flags
under case OP_ENTERSUB.)

S_scalar_mod_type returns false for pos.  I think it should return
true.  That is what this commit does, resulting in consistency
with read():

$ ./perl -Ilib -we 'read($1, @2, $3)'
Can't modify array dereference in read at -e line 1, near "$3)
"
Execution of -e aborted due to compilation errors.
$ ./perl -Ilib -we 'pos(@2)'
Can't modify array dereference in match position at -e line 1, near "@2)
"
Execution of -e aborted due to compilation errors.

Except when it comes to globs, since read refuses *foo for its second
argument, but pos(*foo) has always Just Worked, so there is no reason
to forbid it.

So, now, pos has an effective prototype of (;\[$*]).
---

diff --git a/op.c b/op.c
index 7fcac65..6519521 100644
--- a/op.c
+++ b/op.c
@@ -2060,10 +2060,10 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 STATIC bool
 S_scalar_mod_type(const OP *o, I32 type)
 {
-    assert(o || type != OP_SASSIGN);
-
     switch (type) {
+    case OP_POS:
     case OP_SASSIGN:
+	assert(o);
 	if (o->op_type == OP_RV2GV)
 	    return FALSE;
 	/* FALL THROUGH */
diff --git a/t/op/pos.t b/t/op/pos.t
index 56a8d28..67de5d4 100644
--- a/t/op/pos.t
+++ b/t/op/pos.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 8;
+plan tests => 11;
 
 $x='banana';
 $x=~/.a/g;
@@ -47,3 +47,12 @@ $destroyed = 0;
     $x = bless({}, 'Class');
 }
 is($destroyed, 1, 'Timely scalar destruction with lvalue pos');
+
+eval 'pos @a = 1';
+like $@, qr/^Can't modify array dereference in match position at /,
+  'pos refuses @arrays';
+eval 'pos %a = 1';
+like $@, qr/^Can't modify hash dereference in match position at /,
+  'pos refuses %hashes';
+eval 'pos *a = 1';
+is eval 'pos *a', 1, 'pos *glob works';