This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Handle the rare but legal angle bracket in unixify.
[perl5.git] / vms / ext / filespec.t
CommitLineData
acbb349e 1#!./perl
2
aa689395 3BEGIN { unshift(@INC,'../lib') if -d '../lib'; }
4
acbb349e 5use VMS::Filespec;
0e9538e6 6use File::Spec;
acbb349e 7
8foreach (<DATA>) {
9 chomp;
10 s/\s*#.*//;
11 next if /^\s*$/;
12 push(@tests,$_);
13}
cd5cd3a3
MS
14
15require './test.pl';
16plan(tests => scalar(2*@tests)+6);
acbb349e 17
1fe570cc
JM
18my $vms_unix_rpt;
19my $vms_efs;
20
21if ($^O eq 'VMS') {
22 if (eval 'require VMS::Feature') {
23 $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
24 $vms_efs = VMS::Feature::current("efs_charset");
25 } else {
26 my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
27 my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
28 $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
29 $vms_efs = $efs_charset =~ /^[ET1]/i;
30 }
31}
32
33
34
acbb349e 35foreach $test (@tests) {
1fe570cc
JM
36 ($arg,$func,$expect2,$expect5) = split(/\s+/,$test);
37
38 $expect2 = undef if $expect2 eq 'undef';
39 $expect2 = undef if $expect2 eq '^';
40 $expect5 = undef if $expect5 eq 'undef';
41 $expect5 = $expect2 if $expect5 eq '^';
42
43 if ($vms_efs) {
44 $expect = $expect5;
45 }
46 else {
47 $expect = $expect2;
48 }
cd5cd3a3 49
acbb349e 50 $rslt = eval "$func('$arg')";
9ba1b7d2 51 is($@, '', "eval ${func}('$arg')");
1fe570cc
JM
52 if ($expect ne '^*') {
53 is(lc($rslt), lc($expect), "${func}('$arg'): '$rslt'");
54 }
55 else {
56 is(lc($rslt), lc($expect), "${func}('$arg'): '$rslt' # TODO fix ODS-5 test");
57 }
acbb349e 58}
59
17f28c40
CB
60$defwarn = <<'EOW';
61# Note: This failure may have occurred because your default device
62# was set using a non-concealed logical name. If this is the case,
63# you will need to determine by inspection that the two resultant
9ba1b7d2 64# file specifications shown above are in fact equivalent.
17f28c40
CB
65EOW
66
b4558e59 67is(uc(rmsexpand('[]')), "\U$ENV{DEFAULT}", 'rmsexpand()') || print $defwarn;
51078f7b
CB
68is(lc(rmsexpand('from.here')),"\L$ENV{DEFAULT}from.here") || print $defwarn;
69is(lc(rmsexpand('from')), "\L$ENV{DEFAULT}from") || print $defwarn;
cd5cd3a3 70
51078f7b 71is(lc(rmsexpand('from.here','cant:[get.there];2')),
cd5cd3a3
MS
72 'cant:[get.there]from.here;2') || print $defwarn;
73
acbb349e 74
09b7f37c
CB
75# Make sure we're using redirected mkdir, which strips trailing '/', since
76# the CRTL's mkdir can't handle this.
cd5cd3a3
MS
77ok(mkdir('testdir/',0777), 'using redirected mkdir()');
78ok(rmdir('testdir/'), ' rmdir()');
09b7f37c 79
acbb349e 80__DATA__
81
0e9538e6
CB
82# lots of underscores used to minimize collision with existing logical names
83
acbb349e 84# Basic VMS to Unix filespecs
1fe570cc 85__some_:[__where_.__over_]__the_.__rainbow_ unixify /__some_/__where_/__over_/__the_.__rainbow_ ^
5ad5b34c 86__some_:<__where_.__over_>__the_.__rainbow_ unixify /__some_/__where_/__over_/__the_.__rainbow_ ^
1fe570cc
JM
87[.__some_.__where_.__over_]__the_.__rainbow_ unixify __some_/__where_/__over_/__the_.__rainbow_ ^
88[-.__some_.__where_.__over_]__the_.__rainbow_ unixify ../__some_/__where_/__over_/__the_.__rainbow_ ^
89[.__some_.--.__where_.__over_]__the_.__rainbow_ unixify __some_/../../__where_/__over_/__the_.__rainbow_ ^
90[.__some_...__where_.__over_]__the_.__rainbow_ unixify __some_/.../__where_/__over_/__the_.__rainbow_ ^*
91[...__some_.__where_.__over_]__the_.__rainbow_ unixify .../__some_/__where_/__over_/__the_.__rainbow_ ^*
92[.__some_.__where_.__over_...]__the_.__rainbow_ unixify __some_/__where_/__over_/.../__the_.__rainbow_ ^*
93[.__some_.__where_.__over_...] unixify __some_/__where_/__over_/.../ ^*
94[.__some_.__where_.__over_.-] unixify __some_/__where_/__over_/../ ^
95[] unixify ./ ^
96[-] unixify ../ ^
97[--] unixify ../../ ^
98[...] unixify .../ ^*
99[.$(macro)] unixify $(macro)/ ^
acbb349e 100
101# and back again
1fe570cc
JM
102/__some_/__where_/__over_/__the_.__rainbow_ vmsify __some_:[__where_.__over_]__the_.__rainbow_ ^
103__some_/__where_/__over_/__the_.__rainbow_ vmsify [.__some_.__where_.__over_]__the_.__rainbow_ ^
104../__some_/__where_/__over_/__the_.__rainbow_ vmsify [-.__some_.__where_.__over_]__the_.__rainbow_ ^
105__some_/../../__where_/__over_/__the_.__rainbow_ vmsify [-.__where_.__over_]__the_.__rainbow_ [.__some_.--.__where_.__over_]__the_.__rainbow_
106.../__some_/__where_/__over_/__the_.__rainbow_ vmsify [...__some_.__where_.__over_]__the_.__rainbow_ [.^.^.^..__some_.__where_.__over_]__the_.__rainbow_
107__some_/.../__where_/__over_/__the_.__rainbow_ vmsify [.__some_...__where_.__over_]__the_.__rainbow_ [.__some_.^.^.^..__where_.__over_]__the_.__rainbow_
108/__some_/.../__where_/__over_/__the_.__rainbow_ vmsify __some_:[...__where_.__over_]__the_.__rainbow_ __some_:[^.^.^..__where_.__over_]__the_.__rainbow_
109__some_/__where_/... vmsify [.__some_.__where_...] [.__some_.__where_]^.^.^..
110/__where_/... vmsify __where_:[...] __where_:[]^.^.^..
111. vmsify [] ^
112.. vmsify [-] ^
113../.. vmsify [--] ^
114.../ vmsify [...] [.^.^.^.]
115# Can not predict what / will translate to.
116/ vmsify sys$disk:[000000] ^*
117./$(macro)/ vmsify [.$(macro)] ^
118./$(macro) vmsify []$(macro) ^
119./$(m+ vmsify []$^(m^+ []$^(m^+.
acbb349e 120
121# Fileifying directory specs
1fe570cc
JM
122__down_:[__the_.__garden_.__path_] fileify __down_:[__the_.__garden_]__path_.dir;1 ^
123[.__down_.__the_.__garden_.__path_] fileify [.__down_.__the_.__garden_]__path_.dir;1 ^
124/__down_/__the_/__garden_/__path_ fileify /__down_/__the_/__garden_/__path_.dir;1 /__down_/__the_/__garden_/__path_
125/__down_/__the_/__garden_/__path_/ fileify /__down_/__the_/__garden_/__path_.dir;1 /__down_/__the_/__garden_/__path_
126__down_/__the_/__garden_/__path_ fileify __down_/__the_/__garden_/__path_.dir;1 __down_/__the_/__garden_/__path_
127__down_:[__the_.__garden_]__path_ fileify __down_:[__the_.__garden_]__path_.dir;1 ^
128__down_:[__the_.__garden_]__path_. fileify ^ __down_:[__the_.__garden_]__path_^..dir;1 # N.B. trailing . ==> null type
129__down_:[__the_]__garden_.__path_ fileify ^ __down_:[__the_]__garden_^.__path_.dir;1 #undef
130/__down_/__the_/__garden_/__path_. fileify ^ /__down_/__the_/__garden_/__path_. # N.B. trailing . ==> null type
131/__down_/__the_/__garden_.__path_ fileify ^ /__down_/__the_/__garden_.__path_
acbb349e 132
133# and pathifying them
1fe570cc
JM
134__down_:[__the_.__garden_]__path_.dir;1 pathify __down_:[__the_.__garden_.__path_] ^
135[.__down_.__the_.__garden_]__path_.dir pathify [.__down_.__the_.__garden_.__path_] ^
136/__down_/__the_/__garden_/__path_.dir pathify /__down_/__the_/__garden_/__path_/ ^
137__down_/__the_/__garden_/__path_.dir pathify __down_/__the_/__garden_/__path_/ ^
138__down_:[__the_.__garden_]__path_ pathify __down_:[__the_.__garden_.__path_] ^
139__down_:[__the_.__garden_]__path_. pathify ^ __down_:[__the.__garden_.__path_^.] # N.B. trailing . ==> null type
140__down_:[__the_]__garden_.__path_ pathify ^ __down_:[__the_.__garden_^.__path_] # undef
141/__down_/__the_/__garden_/__path_. pathify /__down_/__the_/__garden_/__path__/ /__down_/__the_/__garden_/__path_./ # N.B. trailing . ==> null type
142/__down_/__the_/__garden_.__path_ pathify /__down_/__the_/__garden____path_/ /__down_/__the_/__garden_.__path_/
143__down_:[__the_.__garden_]__path_.dir;2 pathify ^ #N.B. ;2
144__path_ pathify __path_/ ^
145/__down_/__the_/__garden_/. pathify /__down_/__the_/__garden_/./ ^
146/__down_/__the_/__garden_/.. pathify /__down_/__the_/__garden_/../ ^
147/__down_/__the_/__garden_/... pathify /__down_/__the_/__garden_/.../ ^
148__path_.notdir pathify __path__notdir/ __path_.notdir/
acbb349e 149
150# Both VMS/Unix and file/path conversions
1fe570cc
JM
151__down_:[__the_.__garden_]__path_.dir;1 unixpath /__down_/__the_/__garden_/__path_/ ^
152/__down_/__the_/__garden_/__path_ vmspath __down_:[__the_.__garden_.__path_] ^
153__down_:[__the_.__garden_.__path_] unixpath /__down_/__the_/__garden_/__path_/ ^
154__down_:[__the_.__garden_.__path_...] unixpath /__down_/__the_/__garden_/__path_/.../ # Not translatable
155/__down_/__the_/__garden_/__path_.dir vmspath __down_:[__the_.__garden_.__path_] ^
156[.__down_.__the_.__garden_]__path_.dir unixpath __down_/__the_/__garden_/__path_/ ^
157__down_/__the_/__garden_/__path_ vmspath [.__down_.__the_.__garden_.__path_] ^
158__path_ vmspath [.__path_] ^
159/ vmspath sys$disk:[000000] ^*
50255d58 160/sys$scratch vmspath sys$scratch: ^
acbb349e 161
162# Redundant characters in Unix paths
1fe570cc
JM
163//__some_/__where_//__over_/../__the_.__rainbow_ vmsify __some_:[__where_]__the_.__rainbow_ __some_:[__where_.__over_.-]__the_.__rainbow_
164/__some_/__where_//__over_/./__the_.__rainbow_ vmsify __some_:[__where_.__over_]__the_.__rainbow_ ^
165..//../ vmspath [--] ^
166./././ vmspath [] ^
167./../. vmsify [-] ^
0e9538e6
CB
168
169# Our override of File::Spec->canonpath can do some strange things
1fe570cc
JM
170__dev:[__dir.000000]__foo File::Spec->canonpath __dev:[__dir.000000]__foo ^
171__dev:[__dir.][000000]__foo File::Spec->canonpath __dev:[__dir]__foo ^