R-alpha: patch for return (correction)

Gregory R. Warnes (warnes@biostat.washington.edu)
Sat, 28 Sep 1996 11:52:27 -0700 (PDT)


Date: Sat, 28 Sep 1996 11:52:27 -0700 (PDT)
From: "Gregory R. Warnes" <warnes@biostat.washington.edu>
To: r-testers <r-testers@stat.math.ethz.ch>
Subject: R-alpha: patch for return (correction)


I forgot one file in the patch.  It is corrected below.

-------------------------------------------------------------------------------
    Gregory R. Warnes          | It is high time that the ideal of success
warnes@biostat.washington.edu  |  be replaced by the ideal of service.
                               |                       Albert Einstein
-------------------------------------------------------------------------------

---------- Original message ----------
Date: Sat, 28 Sep 1996 10:56:16 -0700 (PDT)
From: Gregory R. Warnes <warnes@biostat.washington.edu>
To: r-testers <r-testers@stat.math.ethz.ch>
Subject: R-alpha: patch for return


Attached is a patch that enables the R return() function to take a list 
of parameters to return as a list.  Before:

> test _ function(x,y) return(a=x,b=y)
> test(1,2)
[1] 1
> 

with the attached patch, as in S:

> test _ function(x,y) return(a=x,b=y)
> test(1,2)
$a
[1] 1

$b
[1] 2

>

Greg

-------------------------------------------------------------------------------
    Gregory R. Warnes          | It is high time that the ideal of success
warnes@biostat.washington.edu  |  be replaced by the ideal of service.
                               |                       Albert Einstein
-------------------------------------------------------------------------------
/////////////////// CORRECTED PATCH STARTS HERE//////////////////////////////
--- R.orig/src/main/eval.c	Wed Sep 11 19:46:50 1996
+++ src/main/eval.c	Sat Sep 28 10:45:57 1996
@@ -528,10 +528,18 @@
 
 SEXP do_return(SEXP call, SEXP op, SEXP args, SEXP rho)
 {
+        int counter;
 	SEXP s;
-	s = eval(CAR(args), rho);
+
+	if (length(args)==1)
+	  s = eval(CAR(args), rho);
+	else
+	  s = do_makelist(call, op, args, rho);
+	  
 	/* R_Visible = 1; */
+
 	findcontext(CTXT_RETURN, s);
+	
 	/*NOTREACHED*/
 }
 
--- R.orig/src/main/names.c	Wed Sep 18 21:05:23 1996
+++ src/main/names.c	Sat Sep 28 10:44:51 1996
@@ -56,7 +56,7 @@
 {"repeat",	do_repeat,	0,	0,	-1,	PP_REPEAT,	0},
 {"break",	do_break,	CTXT_BREAK,0,	-1,	PP_BREAK,	0},
 {"next",	do_break,	CTXT_NEXT,0,	-1,	PP_NEXT,	0},
-{"return",	do_return,	0,	0,	-1,	PP_RETURN,	0},
+{"return",      do_return,	0,	1,	-1,	PP_RETURN,	0},
 {"stop",	do_stop,	0,	1,	1,	PP_FUNCALL,	0},
 {"warning",	do_warning,	0,	101,	1,	PP_FUNCALL,	0},
 {"function",	do_function,	0,	0,	-1,	PP_FUNCTION,	0},

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
r-testers mailing list -- To (un)subscribe, send
subscribe	or	unsubscribe
(in the "body", not the subject !)  To: r-testers-request@stat.math.ethz.ch
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-