vms/ext/filespec.t

   1 #!./perl
   2
   3 BEGIN { unshift(@INC,'../lib') if -d '../lib'; }
   4
   5 use VMS::Filespec;
   6 use File::Spec;
   7
   8 foreach (<DATA>) {
   9   chomp;
  10   s/\s*#.*//;
  11   next if /^\s*$/;
  12   push(@tests,$_);
  13 }
  14
  15 require './test.pl';
  16 plan(tests => scalar(2*@tests)+6);
  17
  18 my $vms_unix_rpt;
  19 my $vms_efs;
  20
  21 if ($^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
  35 foreach $test (@tests) {
  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   }
  49
  50   $rslt = eval "$func('$arg')";
  51   is($@, '', "eval ${func}('$arg')");
  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   }
  58 }
  59
  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
  64 # file specifications shown above are in fact equivalent.
  65 EOW
  66
  67 is(uc(rmsexpand('[]')),   "\U$ENV{DEFAULT}", 'rmsexpand()') || print $defwarn;
  68 is(lc(rmsexpand('from.here')),"\L$ENV{DEFAULT}from.here") || print $defwarn;
  69 is(lc(rmsexpand('from')),     "\L$ENV{DEFAULT}from")      || print $defwarn;
  70
  71 is(lc(rmsexpand('from.here','cant:[get.there];2')),
  72    'cant:[get.there]from.here;2')                     || print $defwarn;
  73
  74
  75 # Make sure we're using redirected mkdir, which strips trailing '/', since
  76 # the CRTL's mkdir can't handle this.
  77 ok(mkdir('testdir/',0777),      'using redirected mkdir()');
  78 ok(rmdir('testdir/'),           '    rmdir()');
  79
  80 __DATA__
  81
  82 # Column definitions:
  83 #
  84 #  Column 1: Argument (path spec to be transformed)
  85 #  Column 2: Function that is to do the transformation
  86 #  Column 3: Expected result when DECC$EFS_CHARSET is not in effect
  87 #  Column 4: Expected result when DECC$EFS_CHARSET is in effect
  88 #            ^ means expect same result for EFS as for non-EFS
  89 #            ^* means TODO when EFS is in effect
  90
  91 # lots of underscores used to minimize collision with existing logical names
  92
  93 # Basic VMS to Unix filespecs
  94 __some_:[__where_.__over_]__the_.__rainbow_    unixify /__some_/__where_/__over_/__the_.__rainbow_ ^
  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_...] unixify __some_/__where_/__over_/.../ ^
 103 [.__some_.__where_.__over_.-]  unixify __some_/__where_/__over_/../ ^
 104 []      unixify         ./      ^
 105 [-]     unixify         ../     ^
 106 [--]    unixify         ../../  ^
 107 [...]   unixify         .../    ^
 108 __lyrics_:[__are_.__very_^.__sappy_]__but_^.__rhymes_^.__are_.__true_    unixify   /__lyrics_/__are_/__very_.__sappy_/__but_.__rhymes_.__are_.__true_ ^
 109 [.$(macro)]     unixify $(macro)/ ^
 110
 111 # and back again
 112 /__some_/__where_/__over_/__the_.__rainbow_    vmsify  __some_:[__where_.__over_]__the_.__rainbow_ ^
 113 __some_/__where_/__over_/__the_.__rainbow_     vmsify  [.__some_.__where_.__over_]__the_.__rainbow_ ^
 114 ../__some_/__where_/__over_/__the_.__rainbow_  vmsify  [-.__some_.__where_.__over_]__the_.__rainbow_ ^
 115 __some_/../../__where_/__over_/__the_.__rainbow_       vmsify  [.__some_.--.__where_.__over_]__the_.__rainbow_ ^
 116 .../__some_/__where_/__over_/__the_.__rainbow_ vmsify  [...__some_.__where_.__over_]__the_.__rainbow_ [.^.^.^..__some_.__where_.__over_]__the_.__rainbow_
 117 __some_/.../__where_/__over_/__the_.__rainbow_ vmsify  [.__some_...__where_.__over_]__the_.__rainbow_  [.__some_.^.^.^..__where_.__over_]__the_.__rainbow_
 118 /__some_/.../__where_/__over_/__the_.__rainbow_        vmsify  __some_:[...__where_.__over_]__the_.__rainbow_ __some_:[^.^.^..__where_.__over_]__the_.__rainbow_
 119 __some_/__where_/...   vmsify  [.__some_.__where_...] [.__some_.__where_]^.^.^..
 120 /__where_/...  vmsify  __where_:[...] __where_:[]^.^.^..
 121 .       vmsify  []      ^
 122 ..      vmsify  [-]     ^
 123 ../..   vmsify  [--]    ^
 124 .../    vmsify  [...]   [.^.^.^.]
 125 /       vmsify  sys$disk:[000000] ^*
 126 ./$(macro)/     vmsify  [.$(macro)] ^
 127 ./$(macro)      vmsify  []$(macro) ^
 128 ./$(m+  vmsify  []$^(m^+        []$^(m^+.
 129
 130 # Fileifying directory specs
 131 __down_:[__the_.__garden_.__path_]     fileify __down_:[__the_.__garden_]__path_.dir;1 ^
 132 [.__down_.__the_.__garden_.__path_]    fileify [.__down_.__the_.__garden_]__path_.dir;1 ^
 133 /__down_/__the_/__garden_/__path_      fileify /__down_/__the_/__garden_/__path_.dir;1 /__down_/__the_/__garden_/__path_
 134 /__down_/__the_/__garden_/__path_/     fileify /__down_/__the_/__garden_/__path_.dir;1 /__down_/__the_/__garden_/__path_
 135 __down_/__the_/__garden_/__path_       fileify __down_/__the_/__garden_/__path_.dir;1 __down_/__the_/__garden_/__path_
 136 __down_:[__the_.__garden_]__path_      fileify __down_:[__the_.__garden_]__path_.dir;1 ^
 137 __down_:[__the_.__garden_]__path_.     fileify ^ __down_:[__the_.__garden_]__path_^..dir;1 # N.B. trailing . ==> null type
 138 __down_:[__the_]__garden_.__path_      fileify ^ __down_:[__the_]__garden_^.__path_.dir;1 #undef
 139 /__down_/__the_/__garden_/__path_.     fileify ^ /__down_/__the_/__garden_/__path_. # N.B. trailing . ==> null type
 140 /__down_/__the_/__garden_.__path_      fileify ^ /__down_/__the_/__garden_.__path_
 141
 142 # and pathifying them
 143 __down_:[__the_.__garden_]__path_.dir;1        pathify __down_:[__the_.__garden_.__path_] ^
 144 [.__down_.__the_.__garden_]__path_.dir pathify [.__down_.__the_.__garden_.__path_] ^
 145 /__down_/__the_/__garden_/__path_.dir  pathify /__down_/__the_/__garden_/__path_/ ^
 146 __down_/__the_/__garden_/__path_.dir   pathify __down_/__the_/__garden_/__path_/ ^
 147 __down_:[__the_.__garden_]__path_      pathify __down_:[__the_.__garden_.__path_] ^
 148 __down_:[__the_.__garden_]__path_.     pathify ^ __down_:[__the.__garden_.__path_^.] # N.B. trailing . ==> null type
 149 __down_:[__the_]__garden_.__path_      pathify ^ __down_:[__the_.__garden_^.__path_] # undef
 150 /__down_/__the_/__garden_/__path_.     pathify /__down_/__the_/__garden_/__path__/ /__down_/__the_/__garden_/__path_./ # N.B. trailing . ==> null type
 151 /__down_/__the_/__garden_.__path_      pathify /__down_/__the_/__garden____path_/ /__down_/__the_/__garden_.__path_/
 152 __down_:[__the_.__garden_]__path_.dir;2        pathify ^ #N.B. ;2
 153 __path_        pathify __path_/ ^
 154 /__down_/__the_/__garden_/.    pathify /__down_/__the_/__garden_/./ ^
 155 /__down_/__the_/__garden_/..   pathify /__down_/__the_/__garden_/../ ^
 156 /__down_/__the_/__garden_/...  pathify /__down_/__the_/__garden_/.../ ^
 157 __path_.notdir pathify __path__notdir/ __path_.notdir/
 158
 159 # Both VMS/Unix and file/path conversions
 160 __down_:[__the_.__garden_]__path_.dir;1        unixpath        /__down_/__the_/__garden_/__path_/ ^
 161 /__down_/__the_/__garden_/__path_      vmspath __down_:[__the_.__garden_.__path_] ^
 162 __down_:[__the_.__garden_.__path_]     unixpath        /__down_/__the_/__garden_/__path_/ ^
 163 __down_:[__the_.__garden_.__path_...]  unixpath        /__down_/__the_/__garden_/__path_/.../ # Not translatable
 164 /__down_/__the_/__garden_/__path_.dir  vmspath __down_:[__the_.__garden_.__path_] ^
 165 [.__down_.__the_.__garden_]__path_.dir unixpath        __down_/__the_/__garden_/__path_/ ^
 166 __down_/__the_/__garden_/__path_       vmspath [.__down_.__the_.__garden_.__path_] ^
 167 __path_        vmspath [.__path_] ^
 168 /       vmspath sys$disk:[000000] ^*
 169 /sys$scratch    vmspath sys$scratch: ^
 170
 171 # Redundant characters in Unix paths
 172 //__some_/__where_//__over_/../__the_.__rainbow_       vmsify  __some_:[__where_.__over_.-]__the_.__rainbow_ ^
 173 /__some_/__where_//__over_/./__the_.__rainbow_ vmsify  __some_:[__where_.__over_]__the_.__rainbow_ ^
 174 ..//../ vmspath [--] ^
 175 ./././  vmspath [] ^
 176 ./../.  vmsify  [-] ^
 177
 178 # Our override of File::Spec->canonpath can do some strange things
 179 __dev:[__dir.000000]__foo     File::Spec->canonpath   __dev:[__dir.000000]__foo ^
 180 __dev:[__dir.][000000]__foo   File::Spec->canonpath   __dev:[__dir]__foo ^