Overloaded <> and deref again

	Message-Id: <199810300304.WAA23291@monk.mps.ohio-state.edu>

p4raw-id: //depot/perl@2150

10 files changed, 463 insertions, 50 deletions

diff --git a/gv.c b/gv.c
index 1d24fa45e3..f4f0044c7f 100644
--- a/gv.c
+++ b/gv.c
@@ -1269,6 +1269,15 @@ amagic_call(SV *left, SV *right, int method, int flags)
 	     lr = 1;
 	   }
 	   break;
+	 case iter_amg:			/* XXXX Eventually should do to_gv. */
+	 case to_sv_amg:
+	 case to_av_amg:
+	 case to_hv_amg:
+	 case to_gv_amg:
+	 case to_cv_amg:
+	     /* FAIL safe */
+	     return NULL;	/* Delegate operation to standard mechanisms. */
+	     break;
 	 default:
 	   goto not_found;
 	 }
diff --git a/lib/overload.pm b/lib/overload.pm
index 43fef8ae5e..81d9a120ba 100644
--- a/lib/overload.pm
+++ b/lib/overload.pm
@@ -121,6 +121,8 @@ sub mycan {				# Real can would leave stubs.
 	 mutators	  => '++ --',
 	 func		  => "atan2 cos sin exp abs log sqrt",
 	 conversion	  => 'bool "" 0+',
+	 iterators	  => '<>',
+	 dereferencing	  => '${} @{} %{} &{} *{}',
 	 special	  => 'nomethod fallback =');
 
 sub constant {
@@ -362,12 +364,29 @@ for "E<lt>" or "E<lt>=E<gt>" combined with either unary minus or subtraction.
 
     "bool", "\"\"", "0+",
 
-If one or two of these operations are unavailable, the remaining ones can
+If one or two of these operations are not overloaded, the remaining ones can
 be used instead.  C<bool> is used in the flow control operators
 (like C<while>) and for the ternary "C<?:>" operation.  These functions can
 return any arbitrary Perl value.  If the corresponding operation for this value
 is overloaded too, that operation will be called again with this value.
 
+=item * I<Iteration>
+
+    "<>"
+
+If not overloaded, the argument will be converted to a filehandle or
+glob (which may require a stringification).  The same overloading
+happens both for the I<read-filehandle> syntax C<E<lt>$varE<gt>> and
+I<globbing> syntax C<E<lt>${var}E<gt>>.
+
+=item * I<Dereferencing>
+
+    '${}', '@{}', '%{}', '&{}', '*{}'.
+
+If not overloaded, the argument will be dereferenced I<as is>, thus
+should be of correct type.  These functions should return a reference
+of correct type, or another object with overloaded dereferencing.
+
 =item * I<Special>
 
     "nomethod", "fallback", "=",
@@ -392,6 +411,8 @@ A computer-readable form of the above table is available in the hash
  mutators	  => '++ --',
  func		  => 'atan2 cos sin exp abs log sqrt',
  conversion	  => 'bool "" 0+',
+ iterators	  => '<>',
+ dereferencing	  => '${} @{} %{} &{} *{}',
  special	  => 'nomethod fallback ='
 
 =head2 Inheritance and overloading
@@ -589,6 +610,14 @@ C<E<lt>=E<gt>> or C<cmp>:
     <, >, <=, >=, ==, != 	in terms of <=>
     lt, gt, le, ge, eq, ne 	in terms of cmp
 
+=item I<Iterator>
+
+    <>				in terms of builtin operations
+
+=item I<Dereferencing>
+
+    ${} @{} %{} &{} *{}		in terms of builtin operations
+
 =item I<Copy operator>
 
 can be expressed in terms of an assignment to the dereferenced value, if this
@@ -851,6 +880,134 @@ numeric value.)  This prints:
   seven=vii, seven=7, eight=8
   seven contains `i'
 
+=head2 Two-face references
+
+Suppose you want to create an object which is accessible as both an
+array reference, and a hash reference, similar to the builtin
+L<array-accessible-as-a-hash|perlref/"Pseudo-hashes: Using an array as
+a hash"> builtin Perl type.  Let us make it better than the builtin
+type, there will be no restriction that you cannot use the index 0 of
+your array.
+
+  package two_refs;
+  use overload '%{}' => \&gethash, '@{}' => sub { $ {shift()} };
+  sub new { 
+    my $p = shift; 
+    bless \ [@_], $p;
+  }
+  sub gethash {
+    my %h;
+    my $self = shift;
+    tie %h, ref $self, $self;
+    \%h;
+  }
+
+  sub TIEHASH { my $p = shift; bless \ shift, $p }
+  my %fields;
+  my $i = 0;
+  $fields{$_} = $i++ foreach qw{zero one two three};
+  sub STORE { 
+    my $self = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $$self->[$key] = shift;
+  }
+  sub FETCH { 
+    my $self = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $$self->[$key];
+  }
+
+Now one can access an object using both the array and hash syntax:
+
+  my $bar = new two_refs 3,4,5,6;
+  $bar->[2] = 11;
+  $bar->{two} == 11 or die 'bad hash fetch';
+
+Note several important features of this example.  First of all, the
+I<actual> type of $bar is a scalar reference, and we do not overload
+the scalar dereference.  Thus we can get the I<actual> non-overloaded
+contents of $bar by just using C<$$bar> (what we do in functions which
+overload dereference).  Similarly, the object returned by the
+TIEHASH() method is a scalar reference.
+
+Second, we create a new tied hash each time the hash syntax is used.
+This allows us not to worry about a possibility of a reference loop,
+would would lead to a memory leak.
+
+Both these problems can be cured.  Say, if we want to overload hash
+dereference on a reference to an object which is I<implemented> as a
+hash itself, the only problem one has to circumvent is how to access
+this I<actual> hash (as opposed to the I<virtual> exhibited by
+overloaded dereference operator).  Here is one possible fetching routine:
+
+  sub access_hash {
+    my ($self, $key) = (shift, shift);
+    my $class = ref $self;
+    bless $self, 'overload::dummy'; # Disable overloading of %{} 
+    my $out = $self->{$key};
+    bless $self, $class;	# Restore overloading
+    $out;
+  }
+
+To move creation of the tied hash on each access, one may an extra
+level of indirection which allows a non-circular structure of references:
+
+  package two_refs1;
+  use overload '%{}' => sub { ${shift()}->[1] },
+               '@{}' => sub { ${shift()}->[0] };
+  sub new { 
+    my $p = shift; 
+    my $a = [@_];
+    my %h;
+    tie %h, $p, $a;
+    bless \ [$a, \%h], $p;
+  }
+  sub gethash {
+    my %h;
+    my $self = shift;
+    tie %h, ref $self, $self;
+    \%h;
+  }
+
+  sub TIEHASH { my $p = shift; bless \ shift, $p }
+  my %fields;
+  my $i = 0;
+  $fields{$_} = $i++ foreach qw{zero one two three};
+  sub STORE { 
+    my $a = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $a->[$key] = shift;
+  }
+  sub FETCH { 
+    my $a = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $a->[$key];
+  }
+
+Now if $baz is overloaded like this, then C<$bar> is a reference to a
+reference to the intermediate array, which keeps a reference to an
+actual array, and the access hash.  The tie()ing object for the access
+hash is also a reference to a reference to the actual array, so 
+
+=over
+
+=item *
+
+There are no loops of references.
+
+=item *
+
+Both "objects" which are blessed into the class C<two_refs1> are
+references to a reference to an array, thus references to a I<scalar>.
+Thus the accessor expression C<$$foo-E<gt>[$ind]> involves no
+overloaded operations.
+
+=back
+
 =head2 Symbolic calculator
 
 Put this in F<symbolic.pm> in your Perl library directory:
diff --git a/perl.h b/perl.h
index ed72d40ecb..9860c9b00f 100644
--- a/perl.h
+++ b/perl.h
@@ -2472,7 +2472,44 @@ EXT MGVTBL PL_vtbl_amagicelem;
 
 #ifdef OVERLOAD
 
-#define NofAMmeth 58
+enum {
+  fallback_amg,        abs_amg,
+  bool__amg,   nomethod_amg,
+  string_amg,  numer_amg,
+  add_amg,     add_ass_amg,
+  subtr_amg,   subtr_ass_amg,
+  mult_amg,    mult_ass_amg,
+  div_amg,     div_ass_amg,
+  modulo_amg,  modulo_ass_amg,
+  pow_amg,     pow_ass_amg,
+  lshift_amg,  lshift_ass_amg,
+  rshift_amg,  rshift_ass_amg,
+  band_amg,    band_ass_amg,
+  bor_amg,     bor_ass_amg,
+  bxor_amg,    bxor_ass_amg,
+  lt_amg,      le_amg,
+  gt_amg,      ge_amg,
+  eq_amg,      ne_amg,
+  ncmp_amg,    scmp_amg,
+  slt_amg,     sle_amg,
+  sgt_amg,     sge_amg,
+  seq_amg,     sne_amg,
+  not_amg,     compl_amg,
+  inc_amg,     dec_amg,
+  atan2_amg,   cos_amg,
+  sin_amg,     exp_amg,
+  log_amg,     sqrt_amg,
+  repeat_amg,   repeat_ass_amg,
+  concat_amg,  concat_ass_amg,
+  copy_amg,    neg_amg,
+  to_sv_amg,   to_av_amg,
+  to_hv_amg,   to_gv_amg,
+  to_cv_amg,   iter_amg,    
+  max_amg_code,
+};
+
+#define NofAMmeth max_amg_code
+
 #ifdef DOINIT
 EXTCONST char * PL_AMG_names[NofAMmeth] = {
   "fallback",	"abs",			/* "fallback" should be the first. */
@@ -2503,7 +2540,10 @@ EXTCONST char * PL_AMG_names[NofAMmeth] = {
   "log",	"sqrt",
   "x",		"x=",
   ".",		".=",
-  "=",		"neg"
+  "=",		"neg",
+  "${}",	"@{}",
+  "%{}",	"*{}",
+  "&{}",	"<>",
 };
 #else
 EXTCONST char * PL_AMG_names[NofAMmeth];
@@ -2533,37 +2573,6 @@ typedef struct am_table_short AMTS;
 #define AMT_AMAGIC_on(amt)	((amt)->flags |= AMTf_AMAGIC)
 #define AMT_AMAGIC_off(amt)	((amt)->flags &= ~AMTf_AMAGIC)
 
-enum {
-  fallback_amg,	abs_amg,
-  bool__amg,	nomethod_amg,
-  string_amg,	numer_amg,
-  add_amg,	add_ass_amg,
-  subtr_amg,	subtr_ass_amg,
-  mult_amg,	mult_ass_amg,
-  div_amg,	div_ass_amg,
-  modulo_amg,	modulo_ass_amg,
-  pow_amg,	pow_ass_amg,
-  lshift_amg,	lshift_ass_amg,
-  rshift_amg,	rshift_ass_amg,
-  band_amg,	band_ass_amg,
-  bor_amg,	bor_ass_amg,
-  bxor_amg,	bxor_ass_amg,
-  lt_amg,	le_amg,
-  gt_amg,	ge_amg,
-  eq_amg,	ne_amg,
-  ncmp_amg,	scmp_amg,
-  slt_amg,	sle_amg,
-  sgt_amg,	sge_amg,
-  seq_amg,	sne_amg,
-  not_amg,	compl_amg,
-  inc_amg,	dec_amg,
-  atan2_amg,	cos_amg,
-  sin_amg,	exp_amg,
-  log_amg,	sqrt_amg,
-  repeat_amg,   repeat_ass_amg,
-  concat_amg,	concat_ass_amg,
-  copy_amg,	neg_amg
-};
 
 /*
  * some compilers like to redefine cos et alia as faster
diff --git a/pp.c b/pp.c
index babf2c5361..6a308a868f 100644
--- a/pp.c
+++ b/pp.c
@@ -211,6 +211,8 @@ PP(pp_rv2gv)
 
     if (SvROK(sv)) {
       wasref:
+	tryAMAGICunDEREF(to_gv);
+
 	sv = SvRV(sv);
 	if (SvTYPE(sv) == SVt_PVIO) {
 	    GV *gv = (GV*) sv_newmortal();
@@ -256,6 +258,8 @@ PP(pp_rv2sv)
 
     if (SvROK(sv)) {
       wasref:
+	tryAMAGICunDEREF(to_sv);
+
 	sv = SvRV(sv);
 	switch (SvTYPE(sv)) {
 	case SVt_PVAV:
diff --git a/pp.h b/pp.h
index 8e2c7d3679..08e10a7dc8 100644
--- a/pp.h
+++ b/pp.h
@@ -195,19 +195,28 @@
 #define AMG_CALLbinL(left,right,meth) \
             amagic_call(left,right,CAT2(meth,_amg),AMGf_noright)
 
-#define tryAMAGICunW(meth,set) STMT_START { \
+#define tryAMAGICunW(meth,set,shift) STMT_START { \
           if (PL_amagic_generation) { \
 	    SV* tmpsv; \
-	    SV* arg= *(sp); \
+	    SV* arg= sp[shift]; \
+	  am_again: \
 	    if ((SvAMAGIC(arg))&&\
 		(tmpsv=AMG_CALLun(arg,meth))) {\
-	       SPAGAIN;	\
+	       SPAGAIN; if (shift) sp += shift; \
 	       set(tmpsv); RETURN; } \
 	  } \
 	} STMT_END
 
+#define FORCE_SETs(sv) STMT_START { sv_setsv(TARG, (sv)); SETTARG; } STMT_END
+
 #define tryAMAGICun	tryAMAGICunSET
-#define tryAMAGICunSET(meth) tryAMAGICunW(meth,SETs)
+#define tryAMAGICunSET(meth) tryAMAGICunW(meth,SETs,0)
+#define tryAMAGICunTARGET(meth, shift)					\
+	{ dSP; sp--; 	/* get TARGET from below PL_stack_sp */		\
+	    { dTARGETSTACKED; 						\
+		{ dSP; tryAMAGICunW(meth,FORCE_SETs,shift);}}}
+#define setAGAIN(ref) sv = arg = ref; goto am_again;
+#define tryAMAGICunDEREF(meth) tryAMAGICunW(meth,setAGAIN,0)
 
 #define opASSIGN (PL_op->op_flags & OPf_STACKED)
 #define SETsv(sv)	STMT_START {					\
diff --git a/pp_hot.c b/pp_hot.c
index 26bf29cf8c..8e35e8a9c7 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -202,7 +202,23 @@ PP(pp_padsv)
 
 PP(pp_readline)
 {
+    tryAMAGICunTARGET(iter, 0);
     PL_last_in_gv = (GV*)(*PL_stack_sp--);
+    if (PL_op->op_flags & OPf_SPECIAL) {	/* Are called as <$var> */
+	if (SvROK(PL_last_in_gv)) {
+	    if (SvTYPE(SvRV(PL_last_in_gv)) != SVt_PVGV) 
+		goto hard_way;
+	    PL_last_in_gv = (GV*)SvRV(PL_last_in_gv);
+	} else if (SvTYPE(PL_last_in_gv) != SVt_PVGV) {
+	  hard_way: {
+	    dSP;
+	    XPUSHs((SV*)PL_last_in_gv);
+	    PUTBACK;
+	    pp_rv2gv(ARGS);
+	    PL_last_in_gv = (GV*)(*PL_stack_sp--);
+	  }
+	}
+    }
     return do_readline();
 }
 
@@ -403,16 +419,18 @@ PP(pp_print)
 
 PP(pp_rv2av)
 {
-    djSP; dPOPss;
+    djSP; dTOPss;
     AV *av;
 
     if (SvROK(sv)) {
       wasref:
+	tryAMAGICunDEREF(to_av);
+
 	av = (AV*)SvRV(sv);
 	if (SvTYPE(av) != SVt_PVAV)
 	    DIE("Not an ARRAY reference");
 	if (PL_op->op_flags & OPf_REF) {
-	    PUSHs((SV*)av);
+	    SETs((SV*)av);
 	    RETURN;
 	}
     }
@@ -420,7 +438,7 @@ PP(pp_rv2av)
 	if (SvTYPE(sv) == SVt_PVAV) {
 	    av = (AV*)sv;
 	    if (PL_op->op_flags & OPf_REF) {
-		PUSHs((SV*)av);
+		SETs((SV*)av);
 		RETURN;
 	    }
 	}
@@ -441,9 +459,11 @@ PP(pp_rv2av)
 			DIE(PL_no_usym, "an ARRAY");
 		    if (ckWARN(WARN_UNINITIALIZED))
 			warner(WARN_UNINITIALIZED, PL_warn_uninit);
-		    if (GIMME == G_ARRAY)
+		    if (GIMME == G_ARRAY) {
+			POPs;
 			RETURN;
-		    RETPUSHUNDEF;
+		    }
+		    RETSETUNDEF;
 		}
 		sym = SvPV(sv,PL_na);
 		if (PL_op->op_private & HINT_STRICT_REFS)
@@ -456,7 +476,7 @@ PP(pp_rv2av)
 	    if (PL_op->op_private & OPpLVAL_INTRO)
 		av = save_ary(gv);
 	    if (PL_op->op_flags & OPf_REF) {
-		PUSHs((SV*)av);
+		SETs((SV*)av);
 		RETURN;
 	    }
 	}
@@ -464,6 +484,7 @@ PP(pp_rv2av)
 
     if (GIMME == G_ARRAY) {
 	I32 maxarg = AvFILL(av) + 1;
+	POPs;				/* XXXX May be optimized away? */
 	EXTEND(SP, maxarg);          
 	if (SvRMAGICAL(av)) {
 	    U32 i; 
@@ -480,7 +501,7 @@ PP(pp_rv2av)
     else {
 	dTARGET;
 	I32 maxarg = AvFILL(av) + 1;
-	PUSHi(maxarg);
+	SETi(maxarg);
     }
     RETURN;
 }
@@ -492,6 +513,8 @@ PP(pp_rv2hv)
 
     if (SvROK(sv)) {
       wasref:
+	tryAMAGICunDEREF(to_hv);
+
 	hv = (HV*)SvRV(sv);
 	if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV)
 	    DIE("Not a HASH reference");
@@ -2016,6 +2039,10 @@ PP(pp_entersub)
 	    cv = perl_get_cv(sym, TRUE);
 	    break;
 	}
+	{
+	    SV **sp = &sv;		/* Used in tryAMAGICunDEREF macro. */
+	    tryAMAGICunDEREF(to_cv);
+	}	
 	cv = (CV*)SvRV(sv);
 	if (SvTYPE(cv) == SVt_PVCV)
 	    break;
diff --git a/pp_sys.c b/pp_sys.c
index 6ab33d41f8..7ae628bfb2 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -350,6 +350,8 @@ PP(pp_backtick)
 PP(pp_glob)
 {
     OP *result;
+    tryAMAGICunTARGET(iter, -1);
+
     ENTER;
 
 #ifndef VMS
diff --git a/sv.c b/sv.c
index 90a4e0d8fd..807e63c864 100644
--- a/sv.c
+++ b/sv.c
@@ -4047,6 +4047,9 @@ sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref)
 	if (SvGMAGICAL(sv))
 	    mg_get(sv);
 	if (SvROK(sv)) {
+	    SV **sp = &sv;		/* Used in tryAMAGICunDEREF macro. */
+	    tryAMAGICunDEREF(to_cv);
+
 	    cv = (CV*)SvRV(sv);
 	    if (SvTYPE(cv) != SVt_PVCV)
 		croak("Not a subroutine reference");
diff --git a/t/pragma/overload.t b/t/pragma/overload.t
index 0682266ab4..da857715b3 100755
--- a/t/pragma/overload.t
+++ b/t/pragma/overload.t
@@ -706,5 +706,198 @@ test($c, "bareword");	# 135
   my @sorted2 = map $$_, @sorted1;
   test "@sorted2", '0 10 7 4 1 11 8 5 12 2 9 6 3';
 }
+{
+  package iterator;
+  use overload '<>' => \&iter;
+  sub new { my ($p, $v) = @_; bless \$v, $p }
+  sub iter { my ($x) = @_; return undef if $$x < 0; return $$x--; }
+}
+{
+  my $iter = iterator->new(5);
+  my $acc = '';
+  my $out;
+  $acc .= " $out" while $out = <${iter}>;
+  test $acc, ' 5 4 3 2 1 0';	# 175
+  $iter = iterator->new(5);
+  test scalar <${iter}>, '5';	# 176
+  $acc = '';
+  $acc .= " $out" while $out = <$iter>;
+  test $acc, ' 4 3 2 1 0';	# 177
+}
+{
+  package deref;
+  use overload '%{}' => \&hderef, '&{}' => \&cderef, 
+    '*{}' => \&gderef, '${}' => \&sderef, '@{}' => \&aderef;
+  sub new { my ($p, $v) = @_; bless \$v, $p }
+  sub deref {
+    my ($self, $key) = (shift, shift);
+    my $class = ref $self;
+    bless $self, 'deref::dummy'; # Disable overloading of %{} 
+    my $out = $self->{$key};
+    bless $self, $class;	# Restore overloading
+    $out;
+  }
+  sub hderef {shift->deref('h')}
+  sub aderef {shift->deref('a')}
+  sub cderef {shift->deref('c')}
+  sub gderef {shift->deref('g')}
+  sub sderef {shift->deref('s')}
+}
+{
+  my $deref = bless { h => { foo => 5 , fake => 23 },
+		      c => sub {return shift() + 34},
+		      's' => \123,
+		      a => [11..13],
+		      g => \*srt,
+		    }, 'deref';
+  # Hash:
+  my @cont = sort %$deref;
+  test "@cont", '23 5 fake foo';	# 178
+  my @keys = sort keys %$deref;
+  test "@keys", 'fake foo';	# 179
+  my @val = sort values %$deref;
+  test "@val", '23 5';		# 180
+  test $deref->{foo}, 5;	# 181
+  test defined $deref->{bar}, ''; # 182
+  my $key;
+  @keys = ();
+  push @keys, $key while $key = each %$deref;
+  @keys = sort @keys;
+  test "@keys", 'fake foo';	# 183  
+  test exists $deref->{bar}, ''; # 184
+  test exists $deref->{foo}, 1; # 185
+  # Code:
+  test $deref->(5), 39;		# 186
+  test &$deref(6), 40;		# 187
+  sub xxx_goto { goto &$deref }
+  test xxx_goto(7), 41;		# 188
+  my $srt = bless { c => sub {$b <=> $a}
+		  }, 'deref';
+  *srt = \&$srt;
+  my @sorted = sort srt 11, 2, 5, 1, 22;
+  test "@sorted", '22 11 5 2 1'; # 189
+  # Scalar
+  test $$deref, 123;		# 190
+  # Glob
+  @sorted = sort $deref 11, 2, 5, 1, 22;
+  test "@sorted", '22 11 5 2 1'; # 191
+  # Array
+  test "@$deref", '11 12 13';	# 192
+  test $#$deref, '2';		# 193
+  my $l = @$deref;
+  test $l, 3;			# 194
+  test $deref->[2], '13';		# 195
+  $l = pop @$deref;
+  test $l, 13;			# 196
+  $l = 1;
+  test $deref->[$l], '12';	# 197
+  # Repeated dereference
+  my $double = bless { h => $deref,
+		     }, 'deref';
+  test $double->{foo}, 5;	# 198
+}
+
+{
+  package two_refs;
+  use overload '%{}' => \&gethash, '@{}' => sub { ${shift()} };
+  sub new { 
+    my $p = shift; 
+    bless \ [@_], $p;
+  }
+  sub gethash {
+    my %h;
+    my $self = shift;
+    tie %h, ref $self, $self;
+    \%h;
+  }
+
+  sub TIEHASH { my $p = shift; bless \ shift, $p }
+  my %fields;
+  my $i = 0;
+  $fields{$_} = $i++ foreach qw{zero one two three};
+  sub STORE { 
+    my $self = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $$self->[$key] = shift;
+  }
+  sub FETCH { 
+    my $self = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $$self->[$key];
+  }
+}
+
+my $bar = new two_refs 3,4,5,6;
+$bar->[2] = 11;
+test $bar->{two}, 11;		# 199
+$bar->{three} = 13;
+test $bar->[3], 13;		# 200
+
+{
+  package two_refs_o;
+  @ISA = ('two_refs');
+}
+
+$bar = new two_refs_o 3,4,5,6;
+$bar->[2] = 11;
+test $bar->{two}, 11;		# 201
+$bar->{three} = 13;
+test $bar->[3], 13;		# 202
+
+{
+  package two_refs1;
+  use overload '%{}' => sub { ${shift()}->[1] },
+               '@{}' => sub { ${shift()}->[0] };
+  sub new { 
+    my $p = shift; 
+    my $a = [@_];
+    my %h;
+    tie %h, $p, $a;
+    bless \ [$a, \%h], $p;
+  }
+  sub gethash {
+    my %h;
+    my $self = shift;
+    tie %h, ref $self, $self;
+    \%h;
+  }
+
+  sub TIEHASH { my $p = shift; bless \ shift, $p }
+  my %fields;
+  my $i = 0;
+  $fields{$_} = $i++ foreach qw{zero one two three};
+  sub STORE { 
+    my $a = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $a->[$key] = shift;
+  }
+  sub FETCH { 
+    my $a = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $a->[$key];
+  }
+}
+
+$bar = new two_refs_o 3,4,5,6;
+$bar->[2] = 11;
+test $bar->{two}, 11;		# 203
+$bar->{three} = 13;
+test $bar->[3], 13;		# 204
+
+{
+  package two_refs1_o;
+  @ISA = ('two_refs1');
+}
+
+$bar = new two_refs1_o 3,4,5,6;
+$bar->[2] = 11;
+test $bar->{two}, 11;		# 205
+$bar->{three} = 13;
+test $bar->[3], 13;		# 206
+
 # Last test is:
-sub last {174}
+sub last {206}
diff --git a/toke.c b/toke.c
index 9a2fbd6ffd..6755b8aaef 100644
--- a/toke.c
+++ b/toke.c
@@ -5643,16 +5643,16 @@ scan_inputsymbol(char *start)
 	    if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
 		OP *o = newOP(OP_PADSV, 0);
 		o->op_targ = tmp;
-		PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, o));
+		PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, o);
 	    }
 	    else {
 		GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
 		PL_lex_op = (OP*)newUNOP(OP_READLINE, 0,
-					newUNOP(OP_RV2GV, 0,
 					    newUNOP(OP_RV2SV, 0,
-						newGVOP(OP_GV, 0, gv))));
+						newGVOP(OP_GV, 0, gv)));
 	    }
-	    /* we created the ops in lex_op, so make yylval.ival a null op */
+	    PL_lex_op->op_flags |= OPf_SPECIAL;
+	    /* we created the ops in PL_lex_op, so make yylval.ival a null op */
 	    yylval.ival = OP_NULL;
 	}