1#!./perl
2
3use VMS::Filespec;
4use File::Spec;
5
6foreach (<DATA>) {
7  chomp;
8  s/\s*#.*//;
9  next if /^\s*$/;
10  push(@tests,$_);
11}
12
13require 'test.pl';
14plan(tests => scalar(2*@tests)+6);
15
16my $vms_unix_rpt;
17my $vms_efs;
18
19if ($^O eq 'VMS') {
20    if (eval 'require VMS::Feature') {
21        $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
22        $vms_efs = VMS::Feature::current("efs_charset");
23    } else {
24        my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
25        my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
26        $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
27        $vms_efs = $efs_charset =~ /^[ET1]/i;
28    }
29}
30
31
32
33foreach $test (@tests) {
34  ($arg,$func,$expect2,$expect5) = split(/(?<!\\)\s+/,$test);
35
36  $arg =~ s/\\//g; # to get whitespace into the argument escape with \
37  $expect2 =~ s/\\//g;
38  $expect5 =~ s/\\//g;
39  $expect2 = undef if $expect2 eq 'undef';
40  $expect2 = undef if $expect2 eq '^';
41  $expect5 = undef if $expect5 eq 'undef';
42  $expect5 = $expect2 if $expect5 eq '^';
43
44  if ($vms_efs) {
45	$expect = $expect5;
46  }
47  else {
48	$expect = $expect2;
49  }
50
51  $rslt = eval "$func('$arg')";
52  is($@, '', "eval ${func}('$arg')");
53  if ($expect ne '^*') {
54    is(lc($rslt), lc($expect), "${func}('$arg'): '$rslt'");
55  }
56  else {
57    is(lc($rslt), lc($expect), "${func}('$arg'): '$rslt' # TODO fix ODS-5 test");
58  }
59}
60
61$defwarn = <<'EOW';
62# Note: This failure may have occurred because your default device
63# was set using a non-concealed logical name.  If this is the case,
64# you will need to determine by inspection that the two resultant
65# file specifications shown above are in fact equivalent.
66EOW
67
68is(uc(rmsexpand('[]')),   "\U$ENV{DEFAULT}", 'rmsexpand()') || print $defwarn;
69is(lc(rmsexpand('from.here')),"\L$ENV{DEFAULT}from.here") || print $defwarn;
70is(lc(rmsexpand('from')),     "\L$ENV{DEFAULT}from")      || print $defwarn;
71
72is(lc(rmsexpand('from.here','cant:[get.there];2')),
73   'cant:[get.there]from.here;2')                     || print $defwarn;
74
75
76# Make sure we're using redirected mkdir, which strips trailing '/', since
77# the CRTL's mkdir can't handle this.
78ok(mkdir('testdir/',0777),      'using redirected mkdir()');
79ok(rmdir('testdir/'),           '    rmdir()');
80
81__DATA__
82
83# Column definitions:
84#
85#  Column 1: Argument (path spec to be transformed)
86#  Column 2: Function that is to do the transformation
87#  Column 3: Expected result when DECC$EFS_CHARSET is not in effect
88#  Column 4: Expected result when DECC$EFS_CHARSET is in effect
89#            ^ means expect same result for EFS as for non-EFS
90#            ^* means TODO when EFS is in effect
91
92# lots of underscores used to minimize collision with existing logical names
93
94# Basic VMS to Unix filespecs
95__some_:[__where_.__over_]__the_.__rainbow_    unixify /__some_/__where_/__over_/__the_.__rainbow_ ^
96__some_:<__where_.__over_>__the_.__rainbow_    unixify /__some_/__where_/__over_/__the_.__rainbow_ ^
97[.__some_.__where_.__over_]__the_.__rainbow_   unixify __some_/__where_/__over_/__the_.__rainbow_ ^
98[-.__some_.__where_.__over_]__the_.__rainbow_  unixify ../__some_/__where_/__over_/__the_.__rainbow_ ^
99[.__some_.--.__where_.__over_]__the_.__rainbow_        unixify __some_/../../__where_/__over_/__the_.__rainbow_ ^
100[.__some_...__where_.__over_]__the_.__rainbow_ unixify __some_/.../__where_/__over_/__the_.__rainbow_ ^
101[...__some_.__where_.__over_]__the_.__rainbow_ unixify .../__some_/__where_/__over_/__the_.__rainbow_ ^
102[.__some_.__where_.__over_...]__the_.__rainbow_        unixify __some_/__where_/__over_/.../__the_.__rainbow_ ^
103[.__some_.__where_.__over_...] unixify __some_/__where_/__over_/.../ ^
104[.__some_.__where_.__over_.-]  unixify __some_/__where_/__over_/../ ^
105[]	unixify		./	^
106[-]	unixify		../	^
107[--]	unixify		../../	^
108[...]	unixify		.../	^
109__lyrics_:[__are_.__very_^.__sappy_]__but_^.__rhymes_^.__are_.__true_    unixify   /__lyrics_/__are_/__very_.__sappy_/__but_.__rhymes_.__are_.__true_ ^
110[.$(macro)]	unixify	$(macro)/ ^
111^+foo.tmp	unixify +foo.tmp ^
112[-.foo^_^_bar]	unixify ../foo\ \ bar/ ^
113[]foo.tmp	unixify	./foo.tmp ^
114
115# and back again
116/__some_/__where_/__over_/__the_.__rainbow_    vmsify  __some_:[__where_.__over_]__the_.__rainbow_ ^
117__some_/__where_/__over_/__the_.__rainbow_     vmsify  [.__some_.__where_.__over_]__the_.__rainbow_ ^
118../__some_/__where_/__over_/__the_.__rainbow_  vmsify  [-.__some_.__where_.__over_]__the_.__rainbow_ ^
119__some_/../../__where_/__over_/__the_.__rainbow_       vmsify  [.__some_.--.__where_.__over_]__the_.__rainbow_ ^
120.../__some_/__where_/__over_/__the_.__rainbow_ vmsify  [...__some_.__where_.__over_]__the_.__rainbow_ ^
121__some_/.../__where_/__over_/__the_.__rainbow_ vmsify  [.__some_...__where_.__over_]__the_.__rainbow_  ^
122/__some_/.../__where_/__over_/__the_.__rainbow_        vmsify  __some_:[...__where_.__over_]__the_.__rainbow_ ^
123__some_/__where_.DIR;1                         vmsify  [.__some_]__where_.DIR;1 ^
124__some_/_;_where_.DIR;1                        vmsify  [.__some_]_^;_where_.DIR;1 ^
125__some_/__where_/...   vmsify  [.__some_.__where_...] ^
126/__where_/...  vmsify  __where_:[...] ^
127.	vmsify	[]	^
128..	vmsify	[-]	^
129../..	vmsify	[--]	^
130.../	vmsify	[...]	^
131/	vmsify	sys$disk:[000000] ^
132./$(macro)/	vmsify	[.$(macro)] ^
133./$(macro)	vmsify	[]$(macro) ^
134./$(m+	vmsify	[]$^(m^+	^
135foo-bar-0^.01/	vmsify [.foo-bar-0_01] [.foo-bar-0^.01]
136\ foo.tmp	vmsify ^_foo.tmp ^
137+foo.tmp	vmsify ^+foo.tmp ^
138../foo\ \ bar/	vmsify [-.foo^_^_bar] ^
139./foo.tmp	vmsify []foo.tmp ^
140x/r*???????	vmsify [.x]r*??????? ^
141
142# Fileifying directory specs
143__down_:[__the_.__garden_.__path_]     fileify __down_:[__the_.__garden_]__path_.dir;1 ^
144[.__down_.__the_.__garden_.__path_]    fileify [.__down_.__the_.__garden_]__path_.dir;1 ^
145/__down_/__the_/__garden_/__path_      fileify /__down_/__the_/__garden_/__path_.dir;1 ^
146/__down_/__the_/__garden_/__path_/     fileify /__down_/__the_/__garden_/__path_.dir;1 ^
147__down_/__the_/__garden_/__path_       fileify __down_/__the_/__garden_/__path_.dir;1 ^
148__down_:[__the_.__garden_]__path_      fileify __down_:[__the_.__garden_]__path_.dir;1 ^
149__down_:[__the_.__garden_]__path_.     fileify ^ __down_:[__the_.__garden_]__path_^..dir;1 # N.B. trailing . ==> null type
150__down_:[__the_]__garden_.__path_      fileify ^ __down_:[__the_]__garden_^.__path_.dir;1 #undef
151/__down_/__the_/__garden_/__path_.     fileify ^ /__down_/__the_/__garden_/__path_..dir;1 # N.B. trailing . ==> null type
152/__down_/__the_/__garden_.__path_      fileify ^ /__down_/__the_/__garden_.__path_.dir;1
153__down_::__the_:[__garden_.__path_]    fileify __down_::__the_:[__garden_]__path_.dir;1 ^
154__down_::__the_:[__garden_]            fileify __down_::__the_:[000000]__garden_.dir;1 ^
155
156# and pathifying them
157__down_:[__the_.__garden_]__path_.dir;1        pathify __down_:[__the_.__garden_.__path_] ^
158[.__down_.__the_.__garden_]__path_.dir pathify [.__down_.__the_.__garden_.__path_] ^
159/__down_/__the_/__garden_/__path_.dir  pathify /__down_/__the_/__garden_/__path_/ ^
160__down_/__the_/__garden_/__path_.dir   pathify __down_/__the_/__garden_/__path_/ ^
161__down_:[__the_.__garden_]__path_      pathify __down_:[__the_.__garden_.__path_] ^
162__down_:[__the_.__garden_]__path_.     pathify ^ __down_:[__the_.__garden_.__path_^.] # N.B. trailing . ==> null type
163__down_:[__the_]__garden_.__path_      pathify ^ __down_:[__the_.__garden_^.__path_] # undef
164/__down_/__the_/__garden_/__path_.     pathify /__down_/__the_/__garden_/__path__/ /__down_/__the_/__garden_/__path_./ # N.B. trailing . ==> null type
165/__down_/__the_/__garden_.__path_      pathify /__down_/__the_/__garden____path_/ /__down_/__the_/__garden_.__path_/
166__down_:[__the_.__garden_]__path_.dir;2        pathify ^ #N.B. ;2
167__path_        pathify __path_/ ^
168/__down_/__the_/__garden_/.    pathify /__down_/__the_/__garden_/./ ^
169/__down_/__the_/__garden_/..   pathify /__down_/__the_/__garden_/../ ^
170/__down_/__the_/__garden_/...  pathify /__down_/__the_/__garden_/.../ ^
171__path_.notdir pathify __path__notdir/ __path_.notdir/
172
173# Both VMS/Unix and file/path conversions
174__down_:[__the_.__garden_]__path_.dir;1        unixpath        /__down_/__the_/__garden_/__path_/ ^
175/__down_/__the_/__garden_/__path_      vmspath __down_:[__the_.__garden_.__path_] ^
176__down_:[__the_.__garden_.__path_]     unixpath        /__down_/__the_/__garden_/__path_/ ^
177__down_:[__the_.__garden_.__path_...]  unixpath        /__down_/__the_/__garden_/__path_/.../ ^
178/__down_/__the_/__garden_/__path_.dir  vmspath __down_:[__the_.__garden_.__path_] ^
179[.__down_.__the_.__garden_]__path_.dir unixpath        __down_/__the_/__garden_/__path_/ ^
180__down_/__the_/__garden_/__path_       vmspath [.__down_.__the_.__garden_.__path_] ^
181__path_        vmspath [.__path_] ^
182/	vmspath	sys$disk:[000000] ^
183/sys$scratch	vmspath	sys$scratch: ^
184
185# Redundant characters in Unix paths
186//__some_/__where_//__over_/../__the_.__rainbow_       vmsify  __some_:[__where_.__over_.-]__the_.__rainbow_ ^
187/__some_/__where_//__over_/./__the_.__rainbow_ vmsify  __some_:[__where_.__over_]__the_.__rainbow_ ^
188..//../	vmspath	[--] ^
189./././	vmspath	[] ^
190./../.	vmsify	[-] ^
191
192# Our override of File::Spec->canonpath can do some strange things
193__dev:[__dir.000000]__foo     File::Spec->canonpath   __dev:[__dir.000000]__foo ^
194__dev:[__dir.][000000]__foo   File::Spec->canonpath   __dev:[__dir]__foo ^
195