From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Thu, 22 Mar 2001 14:35:46 +0000 (+0000)
Subject: Give a meaning to '&' in n-arg open case:
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e620cd7232b242c1500abd8a6a5b86efdf1c5c2b;p=p5sagit%2Fp5-mst-13.2.git

Give a meaning to '&' in n-arg open case:
  open($fh,"<&",$scalar);
  $scalar can be:
  - an integer which does "fdopen"
    open($fh,"<&",2); # like open($fh,"<&2")
  - something that will yield a file handle via sv_2io()
    useful for dup'ing anonymous handles.
    e.g.:
    open(my $fh,"<&",\*STDIN);
    open(my $dup,"<&",$fh);

p4raw-id: //depot/perlio@9298
---

diff --git a/doio.c b/doio.c
index 5a5b889..a32604e 100644
--- a/doio.c
+++ b/doio.c
@@ -283,29 +283,39 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		strcat(mode, "t");
 
 	    if (*type == '&') {
-		name = type;
 	      duplicity:
 		dodup = 1;
-		name++;
-		if (*name == '=') {
+		type++;
+		if (*type == '=') {
 		    dodup = 0;
-		    name++;
-		}
-		if (num_svs) {
-		    goto unknown_desr;
+		    type++;
 		}
-		if (!*name && supplied_fp)
+		if (!num_svs && !*type && supplied_fp)
 		    /* "<+&" etc. is used by typemaps */
 		    fp = supplied_fp;
 		else {
-		    /*SUPPRESS 530*/
-		    for (; isSPACE(*name); name++) ;
-		    if (isDIGIT(*name))
-			fd = atoi(name);
+		    if (num_svs > 1) {
+			Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io));
+		    }
+		    if (num_svs && SvIOK(*svp))
+			fd = SvUV(*svp);
+		    else if (isDIGIT(*type)) {
+			/*SUPPRESS 530*/
+			for (; isSPACE(*type); type++) ;
+			fd = atoi(type);
+		    }
 		    else {
 			IO* thatio;
-			gv = gv_fetchpv(name,FALSE,SVt_PVIO);
-			thatio = GvIO(gv);
+			if (num_svs) {
+			    thatio = sv_2io(*svp);
+			}
+			else {
+			    GV *thatgv;
+			    /*SUPPRESS 530*/
+			    for (; isSPACE(*type); type++) ;
+			    thatgv = gv_fetchpv(type,FALSE,SVt_PVIO);
+			    thatio = GvIO(thatgv);
+			}
 			if (!thatio) {
 #ifdef EINVAL
 			    SETERRNO(EINVAL,SS$_IVCHAN);
@@ -387,7 +397,6 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		strcat(mode, "t");
 
 	    if (*type == '&') {
-		name = type;
 		goto duplicity;
 	    }
 	    if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) {
@@ -431,8 +440,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	    if (num_svs > 1) {
 		fp = PerlProc_popen_list(mode,num_svs,svp);
 	    }
-	    else
-            {
+	    else {
 		fp = PerlProc_popen(name,mode);
 	    }
 	    IoTYPE(io) = IoTYPE_PIPE;
diff --git a/t/io/open.t b/t/io/open.t
index 0e2d57c..1b54c33 100755
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -3,9 +3,9 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
-}    
+}
 
-# $RCSfile$    
+# $RCSfile$
 $|  = 1;
 use warnings;
 $Is_VMS = $^O eq 'VMS';
@@ -21,11 +21,11 @@ sub ok { print "ok $test\n"; $test++ }
 
 # 1..9
 {
-    unlink("afile") if -f "afile";     
+    unlink("afile") if -f "afile";
     print "$!\nnot " unless open(my $f,"+>afile");
     ok;
     binmode $f;
-    print "not " unless -f "afile";     
+    print "not " unless -f "afile";
     ok;
     print "not " unless print $f "SomeData\n";
     ok;
@@ -36,15 +36,15 @@ sub ok { print "ok $test\n"; $test++ }
     $b = <$f>;
     print "not " unless $b eq "SomeData\n";
     ok;
-    print "not " unless -f $f;     
+    print "not " unless -f $f;
     ok;
-    eval  { die "Message" };   
+    eval  { die "Message" };
     # warn $@;
     print "not " unless $@ =~ /<\$f> line 1/;
     ok;
     print "not " unless close($f);
     ok;
-    unlink("afile");     
+    unlink("afile");
 }
 
 # 10..12
@@ -96,7 +96,7 @@ sub ok { print "ok $test\n"; $test++ }
     print "not " unless -s 'afile' > 20;
     ok;
 
-    unlink("afile");     
+    unlink("afile");
 }
 
 # 24..26
@@ -138,18 +138,18 @@ open my $f, '<&', 'afile';
 1;
 EOE
 ok;
-$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not ";
+$@ =~ /Bad filehandle:\s+afile/ or print "not ($@)";
 ok;
 
 # local $file tests
 
 # 33..41
 {
-    unlink("afile") if -f "afile";     
+    unlink("afile") if -f "afile";
     print "$!\nnot " unless open(local $f,"+>afile");
     ok;
     binmode $f;
-    print "not " unless -f "afile";     
+    print "not " unless -f "afile";
     ok;
     print "not " unless print $f "SomeData\n";
     ok;
@@ -160,15 +160,15 @@ ok;
     $b = <$f>;
     print "not " unless $b eq "SomeData\n";
     ok;
-    print "not " unless -f $f;     
+    print "not " unless -f $f;
     ok;
-    eval  { die "Message" };   
+    eval  { die "Message" };
     # warn $@;
     print "not " unless $@ =~ /<\$f> line 1/;
     ok;
     print "not " unless close($f);
     ok;
-    unlink("afile");     
+    unlink("afile");
 }
 
 # 42..44
@@ -220,7 +220,7 @@ ok;
     print "not " unless -s 'afile' > 20;
     ok;
 
-    unlink("afile");     
+    unlink("afile");
 }
 
 # 56..58
@@ -262,7 +262,7 @@ open local $f, '<&', 'afile';
 1;
 EOE
 ok;
-$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not ";
+$@ =~ /Bad filehandle:\s+afile/ or print "not ($@) ";
 ok;
 
 # 65..66