From: Dominic Dunlop <domo@computer.org>
Date: Wed, 3 Apr 2002 22:44:01 +0000 (+0200)
Subject: Re: [ID 20020401.004] [PATCH] lib/File/Spec/t/rel2abs2rel.t fails if  paths contain... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7ae3282725359873aff1a80e4a702e145ad46b64;p=p5sagit%2Fp5-mst-13.2.git

Re: [ID 20020401.004] [PATCH] lib/File/Spec/t/rel2abs2rel.t fails if  paths contain shell metacharacters
Message-Id: <p05101502b8d10666f60c@[192.168.1.6]>

p4raw-id: //depot/perl@15723
---

diff --git a/lib/File/Spec/t/rel2abs2rel.t b/lib/File/Spec/t/rel2abs2rel.t
index fff3a1b..4c2e2bb 100644
--- a/lib/File/Spec/t/rel2abs2rel.t
+++ b/lib/File/Spec/t/rel2abs2rel.t
@@ -7,6 +7,16 @@ BEGIN {
     chdir 't';
     @INC = '../lib';
 }
+BEGIN {                                # Set up a tiny script file
+    open(F, ">rel2abs2rel$$.pl")
+      or die "Can't open rel2abs2rel$$.pl file for script -- $!\n";
+    print F qq(print "ok\\n"\n);
+    close(F);
+}
+END {
+    unlink("rel2abs2rel$$.pl");
+    unlink("rel2abs2rel$$.tmp");
+}
 
 use Config;
 
@@ -21,20 +31,38 @@ sub safe_rel {
 
     return $perl;
 }
+# Make a putative perl binary say "ok\n". We have to do it this way
+# because the filespec of the binary may contain characters that a
+# command interpreter considers special, so we can't use the obvious
+# `$perl -le "print 'ok'"`. And, for portability, we can't use fork().
+sub sayok{
+    my $perl = shift;
+    open(STDOUTDUP, '>&STDOUT');
+    open(STDOUT, ">rel2abs2rel$$.tmp")
+        or die "Can't open scratch file rel2abs2rel$$.tmp -- $!\n";
+    system($perl, "rel2abs2rel$$.pl");
+    open(STDOUT, '>&STDOUTDUP');
+    close(STDOUTDUP);
+    open(F, "rel2abs2rel$$.tmp");
+    local $/ = undef;
+    my $output = <F>;
+    close(F);
+    return $output;
+}
 
 # Here we make sure File::Spec can properly deal with executables.
 # VMS has some trouble with these.
 my $perl = safe_rel($^X);
-is( `$perl   -le "print 'ok'"`, "ok\n",   '`` works' );
+is( sayok($perl), "ok\n",   '`` works' );
 
 $perl = File::Spec->rel2abs($^X);
-is( `$perl -le "print 'ok'"`, "ok\n",   'rel2abs($^X)' );
+is( sayok($perl), "ok\n",   '`` works' );
 
 $perl = File::Spec->canonpath($perl);
-is( `$perl -le "print 'ok'"`, "ok\n",   'canonpath on abs executable' );
+is( sayok($perl), "ok\n",   'rel2abs($^X)' );
 
 $perl = safe_rel(File::Spec->abs2rel($perl));
-is( `$perl -le "print 'ok'"`, "ok\n",   'abs2rel()' );
+is( sayok($perl), "ok\n",   'canonpath on abs executable' );
 
 $perl = safe_rel(File::Spec->canonpath($^X));
-is( `$perl -le "print 'ok'"`, "ok\n",   'canonpath on rel executable' );
+is(sayok($perl), "ok\n",   'canonpath on rel executable' );