Commit | Line | Data |
e021ab8e |
1 | #!/usr/bin/perl -w |
3bb16ffc |
2 | |
e021ab8e |
3 | # Here we make sure File::Spec can properly deal with executables. |
4 | # VMS has some trouble with these. |
5 | |
6 | use Test::More (-x $^X |
7 | ? (tests => 5) |
8 | : (skip_all => "Can't find an executable file") |
9 | ); |
3bb16ffc |
10 | |
7ae32827 |
11 | BEGIN { # Set up a tiny script file |
12 | open(F, ">rel2abs2rel$$.pl") |
13 | or die "Can't open rel2abs2rel$$.pl file for script -- $!\n"; |
14 | print F qq(print "ok\\n"\n); |
15 | close(F); |
16 | } |
17 | END { |
98a392ec |
18 | 1 while unlink("rel2abs2rel$$.pl"); |
19 | 1 while unlink("rel2abs2rel$$.tmp"); |
7ae32827 |
20 | } |
3bb16ffc |
21 | |
f47fe535 |
22 | use Config; |
b15a22ab |
23 | |
3bb16ffc |
24 | use File::Spec; |
25 | |
1be805e9 |
26 | # Change 'perl' to './perl' so the shell doesn't go looking through PATH. |
27 | sub safe_rel { |
7fad1f89 |
28 | my($perl) = shift; |
29 | $perl = File::Spec->catfile(File::Spec->curdir, $perl) unless |
30 | File::Spec->file_name_is_absolute($perl); |
31 | |
32 | return $perl; |
1be805e9 |
33 | } |
7ae32827 |
34 | # Make a putative perl binary say "ok\n". We have to do it this way |
35 | # because the filespec of the binary may contain characters that a |
36 | # command interpreter considers special, so we can't use the obvious |
37 | # `$perl -le "print 'ok'"`. And, for portability, we can't use fork(). |
38 | sub sayok{ |
39 | my $perl = shift; |
40 | open(STDOUTDUP, '>&STDOUT'); |
41 | open(STDOUT, ">rel2abs2rel$$.tmp") |
42 | or die "Can't open scratch file rel2abs2rel$$.tmp -- $!\n"; |
43 | system($perl, "rel2abs2rel$$.pl"); |
44 | open(STDOUT, '>&STDOUTDUP'); |
45 | close(STDOUTDUP); |
46 | open(F, "rel2abs2rel$$.tmp"); |
47 | local $/ = undef; |
48 | my $output = <F>; |
49 | close(F); |
50 | return $output; |
51 | } |
1be805e9 |
52 | |
a6133dd6 |
53 | print "# Checking manipulations of \$^X=$^X\n"; |
e021ab8e |
54 | |
7fad1f89 |
55 | my $perl = safe_rel($^X); |
e021ab8e |
56 | is( sayok($perl), "ok\n", "`$perl rel2abs2rel$$.pl` works" ); |
7fad1f89 |
57 | |
58 | $perl = File::Spec->rel2abs($^X); |
e021ab8e |
59 | is( sayok($perl), "ok\n", "`$perl rel2abs2rel$$.pl` works" ); |
3bb16ffc |
60 | |
61 | $perl = File::Spec->canonpath($perl); |
e021ab8e |
62 | is( sayok($perl), "ok\n", "canonpath(rel2abs($^X)) = $perl" ); |
3bb16ffc |
63 | |
42873cec |
64 | $perl = safe_rel(File::Spec->abs2rel($perl)); |
e021ab8e |
65 | is( sayok($perl), "ok\n", "safe_rel(abs2rel(canonpath(rel2abs($^X)))) = $perl" ); |
3bb16ffc |
66 | |
7fad1f89 |
67 | $perl = safe_rel(File::Spec->canonpath($^X)); |
e021ab8e |
68 | is( sayok($perl), "ok\n", "safe_rel(canonpath($^X)) = $perl" ); |