[perl5.git] / vms / ext / filespec.t

#!./perl

BEGIN { unshift(@INC,'../lib') if -d '../lib'; }

use VMS::Filespec;
use File::Spec;

foreach (<DATA>) {
  chomp;
  s/\s*#.*//;
  next if /^\s*$/;
  push(@tests,$_);
}

require './test.pl';
plan(tests => scalar(2*@tests)+6);

my $vms_unix_rpt;
my $vms_efs;

if ($^O eq 'VMS') {
    if (eval 'require VMS::Feature') {
        $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
        $vms_efs = VMS::Feature::current("efs_charset");
    } else {
        my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
        my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
        $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; 
        $vms_efs = $efs_charset =~ /^[ET1]/i; 
    }
}


foreach $test (@tests) {
  ($arg,$func,$expect2,$expect5) = split(/\s+/,$test);

  $expect2 = undef if $expect2 eq 'undef';
  $expect2 = undef if $expect2 eq '^';
  $expect5 = undef if $expect5 eq 'undef';
  $expect5 = $expect2 if $expect5 eq '^';

  if ($vms_efs) {
	$expect = $expect5;
  }
  else {
	$expect = $expect2;
  }

  $rslt = eval "$func('$arg')";
  is($@, '', "eval ${func}('$arg')");
  if ($expect ne '^*') {
    is(lc($rslt), lc($expect), "${func}('$arg'): '$rslt'");
  }
  else {
    is(lc($rslt), lc($expect), "${func}('$arg'): '$rslt' # TODO fix ODS-5 test");
  }
}

$defwarn = <<'EOW';
# Note: This failure may have occurred because your default device
# was set using a non-concealed logical name.  If this is the case,
# you will need to determine by inspection that the two resultant
# file specifications shown above are in fact equivalent.
EOW

is(uc(rmsexpand('[]')),   "\U$ENV{DEFAULT}", 'rmsexpand()') || print $defwarn;
is(lc(rmsexpand('from.here')),"\L$ENV{DEFAULT}from.here") || print $defwarn;
is(lc(rmsexpand('from')),     "\L$ENV{DEFAULT}from")      || print $defwarn;

is(lc(rmsexpand('from.here','cant:[get.there];2')),
   'cant:[get.there]from.here;2')                     || print $defwarn;


# Make sure we're using redirected mkdir, which strips trailing '/', since
# the CRTL's mkdir can't handle this.
ok(mkdir('testdir/',0777),      'using redirected mkdir()');
ok(rmdir('testdir/'),           '    rmdir()');

__DATA__

# lots of underscores used to minimize collision with existing logical names

# Basic VMS to Unix filespecs
__some_:[__where_.__over_]__the_.__rainbow_    unixify /__some_/__where_/__over_/__the_.__rainbow_ ^
__some_:<__where_.__over_>__the_.__rainbow_    unixify /__some_/__where_/__over_/__the_.__rainbow_ ^
[.__some_.__where_.__over_]__the_.__rainbow_   unixify __some_/__where_/__over_/__the_.__rainbow_ ^
[-.__some_.__where_.__over_]__the_.__rainbow_  unixify ../__some_/__where_/__over_/__the_.__rainbow_ ^
[.__some_.--.__where_.__over_]__the_.__rainbow_        unixify __some_/../../__where_/__over_/__the_.__rainbow_ ^
[.__some_...__where_.__over_]__the_.__rainbow_ unixify __some_/.../__where_/__over_/__the_.__rainbow_ ^*
[...__some_.__where_.__over_]__the_.__rainbow_ unixify .../__some_/__where_/__over_/__the_.__rainbow_ ^*
[.__some_.__where_.__over_...]__the_.__rainbow_        unixify __some_/__where_/__over_/.../__the_.__rainbow_ ^*
[.__some_.__where_.__over_...] unixify __some_/__where_/__over_/.../ ^*
[.__some_.__where_.__over_.-]  unixify __some_/__where_/__over_/../ ^
[]	unixify		./	^
[-]	unixify		../	^
[--]	unixify		../../	^
[...]	unixify		.../	^*
[.$(macro)]	unixify	$(macro)/ ^

# and back again
/__some_/__where_/__over_/__the_.__rainbow_    vmsify  __some_:[__where_.__over_]__the_.__rainbow_ ^
__some_/__where_/__over_/__the_.__rainbow_     vmsify  [.__some_.__where_.__over_]__the_.__rainbow_ ^
../__some_/__where_/__over_/__the_.__rainbow_  vmsify  [-.__some_.__where_.__over_]__the_.__rainbow_ ^
__some_/../../__where_/__over_/__the_.__rainbow_       vmsify  [-.__where_.__over_]__the_.__rainbow_  [.__some_.--.__where_.__over_]__the_.__rainbow_
.../__some_/__where_/__over_/__the_.__rainbow_ vmsify  [...__some_.__where_.__over_]__the_.__rainbow_ [.^.^.^..__some_.__where_.__over_]__the_.__rainbow_
__some_/.../__where_/__over_/__the_.__rainbow_ vmsify  [.__some_...__where_.__over_]__the_.__rainbow_  [.__some_.^.^.^..__where_.__over_]__the_.__rainbow_
/__some_/.../__where_/__over_/__the_.__rainbow_        vmsify  __some_:[...__where_.__over_]__the_.__rainbow_ __some_:[^.^.^..__where_.__over_]__the_.__rainbow_
__some_/__where_/...   vmsify  [.__some_.__where_...] [.__some_.__where_]^.^.^..
/__where_/...  vmsify  __where_:[...] __where_:[]^.^.^..
.	vmsify	[]	^
..	vmsify	[-]	^
../..	vmsify	[--]	^
.../	vmsify	[...]	[.^.^.^.]
# Can not predict what / will translate to.
/	vmsify	sys$disk:[000000] ^*
./$(macro)/	vmsify	[.$(macro)] ^
./$(macro)	vmsify	[]$(macro) ^
./$(m+	vmsify	[]$^(m^+	[]$^(m^+.

# Fileifying directory specs
__down_:[__the_.__garden_.__path_]     fileify __down_:[__the_.__garden_]__path_.dir;1 ^
[.__down_.__the_.__garden_.__path_]    fileify [.__down_.__the_.__garden_]__path_.dir;1 ^
/__down_/__the_/__garden_/__path_      fileify /__down_/__the_/__garden_/__path_.dir;1 /__down_/__the_/__garden_/__path_
/__down_/__the_/__garden_/__path_/     fileify /__down_/__the_/__garden_/__path_.dir;1 /__down_/__the_/__garden_/__path_
__down_/__the_/__garden_/__path_       fileify __down_/__the_/__garden_/__path_.dir;1 __down_/__the_/__garden_/__path_
__down_:[__the_.__garden_]__path_      fileify __down_:[__the_.__garden_]__path_.dir;1 ^
__down_:[__the_.__garden_]__path_.     fileify ^ __down_:[__the_.__garden_]__path_^..dir;1 # N.B. trailing . ==> null type
__down_:[__the_]__garden_.__path_      fileify ^ __down_:[__the_]__garden_^.__path_.dir;1 #undef
/__down_/__the_/__garden_/__path_.     fileify ^ /__down_/__the_/__garden_/__path_. # N.B. trailing . ==> null type
/__down_/__the_/__garden_.__path_      fileify ^ /__down_/__the_/__garden_.__path_

# and pathifying them
__down_:[__the_.__garden_]__path_.dir;1        pathify __down_:[__the_.__garden_.__path_] ^
[.__down_.__the_.__garden_]__path_.dir pathify [.__down_.__the_.__garden_.__path_] ^
/__down_/__the_/__garden_/__path_.dir  pathify /__down_/__the_/__garden_/__path_/ ^
__down_/__the_/__garden_/__path_.dir   pathify __down_/__the_/__garden_/__path_/ ^
__down_:[__the_.__garden_]__path_      pathify __down_:[__the_.__garden_.__path_] ^
__down_:[__the_.__garden_]__path_.     pathify ^ __down_:[__the.__garden_.__path_^.] # N.B. trailing . ==> null type
__down_:[__the_]__garden_.__path_      pathify ^ __down_:[__the_.__garden_^.__path_] # undef
/__down_/__the_/__garden_/__path_.     pathify /__down_/__the_/__garden_/__path__/ /__down_/__the_/__garden_/__path_./ # N.B. trailing . ==> null type
/__down_/__the_/__garden_.__path_      pathify /__down_/__the_/__garden____path_/ /__down_/__the_/__garden_.__path_/
__down_:[__the_.__garden_]__path_.dir;2        pathify ^ #N.B. ;2
__path_        pathify __path_/ ^
/__down_/__the_/__garden_/.    pathify /__down_/__the_/__garden_/./ ^
/__down_/__the_/__garden_/..   pathify /__down_/__the_/__garden_/../ ^
/__down_/__the_/__garden_/...  pathify /__down_/__the_/__garden_/.../ ^ 
__path_.notdir pathify __path__notdir/ __path_.notdir/

# Both VMS/Unix and file/path conversions
__down_:[__the_.__garden_]__path_.dir;1        unixpath        /__down_/__the_/__garden_/__path_/ ^
/__down_/__the_/__garden_/__path_      vmspath __down_:[__the_.__garden_.__path_] ^
__down_:[__the_.__garden_.__path_]     unixpath        /__down_/__the_/__garden_/__path_/ ^
__down_:[__the_.__garden_.__path_...]  unixpath        /__down_/__the_/__garden_/__path_/.../ # Not translatable
/__down_/__the_/__garden_/__path_.dir  vmspath __down_:[__the_.__garden_.__path_] ^
[.__down_.__the_.__garden_]__path_.dir unixpath        __down_/__the_/__garden_/__path_/ ^
__down_/__the_/__garden_/__path_       vmspath [.__down_.__the_.__garden_.__path_] ^
__path_        vmspath [.__path_] ^
/	vmspath	sys$disk:[000000] ^*
/sys$scratch	vmspath	sys$scratch: ^

# Redundant characters in Unix paths
//__some_/__where_//__over_/../__the_.__rainbow_       vmsify  __some_:[__where_]__the_.__rainbow_ __some_:[__where_.__over_.-]__the_.__rainbow_
/__some_/__where_//__over_/./__the_.__rainbow_ vmsify  __some_:[__where_.__over_]__the_.__rainbow_ ^
..//../	vmspath	[--] ^
./././	vmspath	[] ^
./../.	vmsify	[-] ^

# Our override of File::Spec->canonpath can do some strange things
__dev:[__dir.000000]__foo     File::Spec->canonpath   __dev:[__dir.000000]__foo ^
__dev:[__dir.][000000]__foo   File::Spec->canonpath   __dev:[__dir]__foo ^
Commit	Line	Data
acbb349e	1	#!./perl
acbb349e	2
aa689395	3	BEGIN { unshift(@INC,'../lib') if -d '../lib'; }
aa689395	4
acbb349e	5	use VMS::Filespec;
0e9538e6	6	use File::Spec;
acbb349e	7
	8	foreach (<DATA>) {
	9	chomp;
	10	s/\s#.//;
	11	next if /^\s*$/;
	12	push(@tests,$_);
	13	}
cd5cd3a3 MS	14
	15	require './test.pl';
	16	plan(tests => scalar(2*@tests)+6);
acbb349e	17
1fe570cc JM	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
acbb349e	35	foreach $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	}
acbb349e	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	65	EOW
17f28c40 CB	66
b4558e59	67	is(uc(rmsexpand('[]')), "\U$ENV{DEFAULT}", 'rmsexpand()') \|\| print $defwarn;
51078f7b CB	68	is(lc(rmsexpand('from.here')),"\L$ENV{DEFAULT}from.here") \|\| print $defwarn;
51078f7b CB	69	is(lc(rmsexpand('from')), "\L$ENV{DEFAULT}from") \|\| print $defwarn;
cd5cd3a3	70
51078f7b	71	is(lc(rmsexpand('from.here','cant:[get.there];2')),
cd5cd3a3 MS	72	'cant:[get.there]from.here;2') \|\| print $defwarn;
cd5cd3a3 MS	73
acbb349e	74
09b7f37c CB	75	# Make sure we're using redirected mkdir, which strips trailing '/', since
09b7f37c CB	76	# the CRTL's mkdir can't handle this.
cd5cd3a3 MS	77	ok(mkdir('testdir/',0777), 'using redirected mkdir()');
cd5cd3a3 MS	78	ok(rmdir('testdir/'), ' rmdir()');
09b7f37c	79
acbb349e	80	__DATA__
acbb349e	81
0e9538e6 CB	82	# lots of underscores used to minimize collision with existing logical names
0e9538e6 CB	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
acbb349e	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
acbb349e	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
acbb349e	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
acbb349e	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
acbb349e	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
0e9538e6 CB	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 ^
1fe570cc JM	171	__dev:[__dir.][000000]__foo File::Spec->canonpath __dev:[__dir]__foo ^