Commit | Line | Data |
3bb16ffc |
1 | #!./perl -w |
2 | |
3 | # Herein we apply abs2rel, rel2abs and canonpath against various real |
4 | # world files and make sure it all actually works. |
5 | |
6 | BEGIN { |
7 | chdir 't'; |
8 | @INC = '../lib'; |
9 | } |
7ae32827 |
10 | BEGIN { # Set up a tiny script file |
11 | open(F, ">rel2abs2rel$$.pl") |
12 | or die "Can't open rel2abs2rel$$.pl file for script -- $!\n"; |
13 | print F qq(print "ok\\n"\n); |
14 | close(F); |
15 | } |
16 | END { |
17 | unlink("rel2abs2rel$$.pl"); |
18 | unlink("rel2abs2rel$$.tmp"); |
19 | } |
3bb16ffc |
20 | |
f47fe535 |
21 | use Config; |
b15a22ab |
22 | |
3bb16ffc |
23 | use Test::More tests => 5; |
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 | |
3bb16ffc |
53 | # Here we make sure File::Spec can properly deal with executables. |
54 | # VMS has some trouble with these. |
7fad1f89 |
55 | my $perl = safe_rel($^X); |
7ae32827 |
56 | is( sayok($perl), "ok\n", '`` works' ); |
7fad1f89 |
57 | |
58 | $perl = File::Spec->rel2abs($^X); |
7ae32827 |
59 | is( sayok($perl), "ok\n", '`` works' ); |
3bb16ffc |
60 | |
61 | $perl = File::Spec->canonpath($perl); |
7ae32827 |
62 | is( sayok($perl), "ok\n", 'rel2abs($^X)' ); |
3bb16ffc |
63 | |
42873cec |
64 | $perl = safe_rel(File::Spec->abs2rel($perl)); |
7ae32827 |
65 | is( sayok($perl), "ok\n", 'canonpath on abs executable' ); |
3bb16ffc |
66 | |
7fad1f89 |
67 | $perl = safe_rel(File::Spec->canonpath($^X)); |
7ae32827 |
68 | is(sayok($perl), "ok\n", 'canonpath on rel executable' ); |