develooper Front page | perl.perl5.porters | Postings from January 2001

[PATCH] Final lvsub patch: arrays and hashes

Thread Next
From:
Simon Cozens
Date:
January 4, 2001 04:42
Subject:
[PATCH] Final lvsub patch: arrays and hashes
Message ID:
20010104124122.A30514@deep-dark-truthful-mirror.perlhacker.org
OK, this completes Perl's lvalue sub implementation, modulo the bug whereby
op->next is LEAVE and op->next->...->next is LEAVESUBLV|RETURN. That'll be
fixed when Stephen does the mod() modification; that'll need a change of
definition for LVRET in pp.h, obviously, but shouldn't interfere with this
patch.

So, while some of the workings are going to change, this patch plus the
previous one (lvalue hash and array elements) contain all the tests you need
to make sure it works, (actually, more tests are needed for more complex subs,
but this will test that the basics work at all) plus all the places where you
need to check LVRET. Hence, I think those would be a useful starting point.

What I would suggest as the way forward is that Stephen grabs bleadperl,
applies these two patches to his tree, does the mod() hack, changes LVRET to
check his flag instead of "PL_op->op_next && ...", and then produces a
consolidated patch against bleadperl which makes the whole thing work.

That would be really really cool.

--- pod/perlsub.pod~	Thu Jan  4 12:20:03 2001
+++ pod/perlsub.pod	Thu Jan  4 12:20:09 2001
@@ -645,10 +645,6 @@
 
 all the subroutines are called in a list context.
 
-The current implementation does not allow arrays and hashes to be
-returned from lvalue subroutines directly.  You may return a
-reference instead.  This restriction may be lifted in future.
-
 =head2 Passing Symbol Table Entries (typeglobs)
 
 B<WARNING>: The mechanism described in this section was originally
--- pp.c~	Thu Jan  4 12:11:42 2001
+++ pp.c	Thu Jan  4 12:12:01 2001
@@ -111,7 +111,7 @@
     if (PL_op->op_private & OPpLVAL_INTRO)
 	SAVECLEARSV(PL_curpad[PL_op->op_targ]);
     EXTEND(SP, 1);
-    if (PL_op->op_flags & OPf_REF) {
+    if (PL_op->op_flags & OPf_REF || LVRET) {
 	PUSHs(TARG);
 	RETURN;
     }
@@ -147,7 +147,7 @@
     XPUSHs(TARG);
     if (PL_op->op_private & OPpLVAL_INTRO)
 	SAVECLEARSV(PL_curpad[PL_op->op_targ]);
-    if (PL_op->op_flags & OPf_REF)
+    if (PL_op->op_flags & OPf_REF || LVRET)
 	RETURN;
     gimme = GIMME_V;
     if (gimme == G_ARRAY) {
--- op.c~	Thu Jan  4 12:02:54 2001
+++ op.c	Thu Jan  4 12:03:34 2001
@@ -6898,25 +6898,6 @@
 	    }
 	    /* FALL THROUGH */
 
-	case OP_LEAVESUBLV:
-	    if (last_composite) {
-		OP *r = last_composite;
-
-		while (r->op_sibling)
-		   r = r->op_sibling;
-		if (r->op_next == o
-		    || (r->op_next->op_type == OP_LIST
-			&& r->op_next->op_next == o))
-		{
-		    if (last_composite->op_type == OP_RV2AV)
-			yyerror("Lvalue subs returning arrays not implemented yet");
-		    else
-			yyerror("Lvalue subs returning hashes not implemented yet");
-			;
-                }
-	    } 
-	    /* FALL THROUGH */
-
 	default:
 	    o->op_seq = PL_op_seqmax++;
 	    break;
--- pp_hot.c~	Thu Jan  4 11:46:45 2001
+++ pp_hot.c	Thu Jan  4 12:04:52 2001
@@ -717,7 +717,7 @@
 	    av = GvAVn(gv);
 	    if (PL_op->op_private & OPpLVAL_INTRO)
 		av = save_ary(gv);
-	    if (PL_op->op_flags & OPf_REF) {
+	    if (PL_op->op_flags & OPf_REF || LVRET) {
 		SETs((SV*)av);
 		RETURN;
 	    }
@@ -821,7 +821,7 @@
 	    hv = GvHVn(gv);
 	    if (PL_op->op_private & OPpLVAL_INTRO)
 		hv = save_hash(gv);
-	    if (PL_op->op_flags & OPf_REF) {
+	    if (PL_op->op_flags & OPf_REF || LVRET) {
 		SETs((SV*)hv);
 		RETURN;
 	    }
--- t/pragma/sub_lval.t~	Thu Jan  4 12:05:47 2001
+++ t/pragma/sub_lval.t	Thu Jan  4 12:18:45 2001
@@ -1,4 +1,4 @@
-print "1..54\n";
+print "1..58\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -476,4 +476,27 @@
 $hash{bar} = "not ok 54\n";
 hlv("bar") = "ok 54\n";
 print hlv("bar");
+
+sub array : lvalue  { @array  }
+sub array2 : lvalue { @array2 } # This is a global.
+sub hash : lvalue   { %hash   }
+sub hash2 : lvalue  { %hash2  } # So's this.
+@array2 = qw(foo bar);
+%hash2 = qw(foo bar);
+
+(array()) = qw(ok 55);
+print "not " unless "@array" eq "ok 55";
+print "ok 55\n";
+
+(array2()) = qw(ok 56);
+print "not " unless "@array2" eq "ok 56";
+print "ok 56\n";
+
+(hash()) = qw(ok 57);
+print "not " unless $hash{ok} == 57;
+print "ok 57\n";
+
+(hash2()) = qw(ok 58);
+print "not " unless $hash2{ok} == 58;
+print "ok 58\n";
 }


-- 
Mohandas K. Gandhi often changed his mind publicly.  An aide once asked him
how he could so freely contradict this week what he had said just last week.
The great man replied that it was because this week he knew better.

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About