6d421e1ad9281ab962e7b5bb8bcfdddf9f59287d
[perl.git] / ext / VMS-Filespec / t / filespec.t
1 #!./perl
2
3 use VMS::Filespec;
4 use File::Spec;
5
6 foreach (<DATA>) {
7   chomp;
8   s/\s*#.*//;
9   next if /^\s*$/;
10   push(@tests,$_);
11 }
12
13 require 'test.pl';
14 plan(tests => scalar(2*@tests)+6);
15
16 my $vms_unix_rpt;
17 my $vms_efs;
18
19 if ($^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
33 foreach $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.
66 EOW
67
68 is(uc(rmsexpand('[]')),   "\U$ENV{DEFAULT}", 'rmsexpand()') || print $defwarn;
69 is(lc(rmsexpand('from.here')),"\L$ENV{DEFAULT}from.here") || print $defwarn;
70 is(lc(rmsexpand('from')),     "\L$ENV{DEFAULT}from")      || print $defwarn;
71
72 is(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.
78 ok(mkdir('testdir/',0777),      'using redirected mkdir()');
79 ok(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^+        ^
135 foo-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 ^
140
141 # Fileifying directory specs
142 __down_:[__the_.__garden_.__path_]     fileify __down_:[__the_.__garden_]__path_.dir;1 ^
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 # N.B. trailing . ==> null type
149 __down_:[__the_]__garden_.__path_      fileify ^ __down_:[__the_]__garden_^.__path_.dir;1 #undef
150 /__down_/__the_/__garden_/__path_.     fileify ^ /__down_/__the_/__garden_/__path_..dir;1 # N.B. trailing . ==> null type
151 /__down_/__the_/__garden_.__path_      fileify ^ /__down_/__the_/__garden_.__path_.dir;1
152 __down_::__the_:[__garden_.__path_]    fileify __down_::__the_:[__garden_]__path_.dir;1 ^
153 __down_::__the_:[__garden_]            fileify __down_::__the_:[000000]__garden_.dir;1 ^
154
155 # and pathifying them
156 __down_:[__the_.__garden_]__path_.dir;1        pathify __down_:[__the_.__garden_.__path_] ^
157 [.__down_.__the_.__garden_]__path_.dir 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_      pathify __down_:[__the_.__garden_.__path_] ^
161 __down_:[__the_.__garden_]__path_.     pathify ^ __down_:[__the_.__garden_.__path_^.] # N.B. trailing . ==> null type
162 __down_:[__the_]__garden_.__path_      pathify ^ __down_:[__the_.__garden_^.__path_] # undef
163 /__down_/__the_/__garden_/__path_.     pathify /__down_/__the_/__garden_/__path__/ /__down_/__the_/__garden_/__path_./ # N.B. trailing . ==> null type
164 /__down_/__the_/__garden_.__path_      pathify /__down_/__the_/__garden____path_/ /__down_/__the_/__garden_.__path_/
165 __down_:[__the_.__garden_]__path_.dir;2        pathify ^ #N.B. ;2
166 __path_        pathify __path_/ ^
167 /__down_/__the_/__garden_/.    pathify /__down_/__the_/__garden_/./ ^
168 /__down_/__the_/__garden_/..   pathify /__down_/__the_/__garden_/../ ^
169 /__down_/__the_/__garden_/...  pathify /__down_/__the_/__garden_/.../ ^ 
170 __path_.notdir pathify __path__notdir/ __path_.notdir/
171
172 # Both VMS/Unix and file/path conversions
173 __down_:[__the_.__garden_]__path_.dir;1        unixpath        /__down_/__the_/__garden_/__path_/ ^
174 /__down_/__the_/__garden_/__path_      vmspath __down_:[__the_.__garden_.__path_] ^
175 __down_:[__the_.__garden_.__path_]     unixpath        /__down_/__the_/__garden_/__path_/ ^
176 __down_:[__the_.__garden_.__path_...]  unixpath        /__down_/__the_/__garden_/__path_/.../ ^
177 /__down_/__the_/__garden_/__path_.dir  vmspath __down_:[__the_.__garden_.__path_] ^
178 [.__down_.__the_.__garden_]__path_.dir unixpath        __down_/__the_/__garden_/__path_/ ^
179 __down_/__the_/__garden_/__path_       vmspath [.__down_.__the_.__garden_.__path_] ^
180 __path_        vmspath [.__path_] ^
181 /       vmspath sys$disk:[000000] ^
182 /sys$scratch    vmspath sys$scratch: ^
183
184 # Redundant characters in Unix paths
185 //__some_/__where_//__over_/../__the_.__rainbow_       vmsify  __some_:[__where_.__over_.-]__the_.__rainbow_ ^
186 /__some_/__where_//__over_/./__the_.__rainbow_ vmsify  __some_:[__where_.__over_]__the_.__rainbow_ ^
187 ..//../ vmspath [--] ^
188 ./././  vmspath [] ^
189 ./../.  vmsify  [-] ^
190
191 # Our override of File::Spec->canonpath can do some strange things
192 __dev:[__dir.000000]__foo     File::Spec->canonpath   __dev:[__dir.000000]__foo ^
193 __dev:[__dir.][000000]__foo   File::Spec->canonpath   __dev:[__dir]__foo ^