Bug #33877 for File-Policy: PATCH for VMS for test case file_slurp_withinpolicy.t

Thanks for File::Policy 1.005 Attached is a patch that gets the test file t/file_slurp_withinpolicy.t to pass all it's tests on VMS. VMS has a case insensitive file system by default, on the default file system (ODS-2) files must have a period (dot) in them, the filesystem is version controlled so when removing/deleteing files using unlink all versions must be removed/deleted. Cheers Peter (Stig) Edwards If you want to know more, here are some links: Perldoc: http://perldoc.perl.org/perlport.html#VMS http://perldoc.perl.org/perlport.html#Files-and-Filesystems http://perldoc.perl.org/perlvms.html#unlink-LIST Perl talk: http://www.perlmonks.org/?node_id=324636 http://www.perl.com/pub/a/2001/05/p5pdigest/THISWEEK-20010513.html Perl mod: http://search.cpan.org/~saper/Test-Portability-Files-0.05/ ODS-2 (Files 11) http://en.wikipedia.org/wiki/Files-11 http://h71000.www7.hp.com/doc/731FINAL/4506/4506pro_015.html

==== t/file_slurp_withinpolicy.t#1 - t/file_slurp_withinpolicy.t ==== --- t70391575227.tmp Fri Mar 7 08:02:14 2008 +++ t/file_slurp_withinpolicy.t Fri Mar 7 07:53:44 2008 @@ -33,7 +33,10 @@ my $root = cwd(); # clear the decks for the temp files -unlink("$root/FSWP_TEST", "$root/FSWP_TEST_LIST", "$root/FSWP_TEST_REF", "$root/FSWP_TEST_BLOCK", "$root/FSWP_TEST_APPEND"); +my @tmp_files = qw(FSWP_TEST.TMP FSWP_TEST_LIST.TMP FSWP_TEST_REF.TMP FSWP_TEST_BLOCK.TMP FSWP_TEST_APPEND.TMP); +foreach my $tmp_file (@tmp_files) { + 1 while unlink(File::Spec->catfile($root,$tmp_file)); +} # let's set $/ to be something unusual to check we can handle it $/ = 'r'; @@ -41,23 +44,23 @@ #################################################################### # simple read and write $o = 'this is a test'; -ASSERT( overwrite_file("$root/FSWP_TEST", $o) , 'write file - string'); -ASSERT( ($i = read_file("$root/FSWP_TEST")) , 'read back'); +ASSERT( overwrite_file(File::Spec->catfile($root,'FSWP_TEST.TMP'), $o) , 'write file - string'); +ASSERT( ($i = read_file(File::Spec->catfile($root,'FSWP_TEST.TMP'))) , 'read back'); ASSERT( ($i eq $o), 'ensure data matches' ); #################################################################### # Write by reference $o = 'this is a reference test'; -ASSERT( write_file("$root/FSWP_TEST_REF", \$o) , 'write file - string reference'); -ASSERT( $i = read_file("$root/FSWP_TEST_REF") , 'read back'); +ASSERT( write_file(File::Spec->catfile($root,'FSWP_TEST_REF.TMP'), \$o) , 'write file - string reference'); +ASSERT( $i = read_file(File::Spec->catfile($root,'FSWP_TEST_REF.TMP')) , 'read back'); ASSERT( ($i eq $o) , 'ensure data matches'); #################################################################### # Read back into a buffer ref $o = 't' x 100000; -ASSERT( write_file("$root/FSWP_TEST_REF", {buf_ref => \$o}) , 'write file - string reference 1e5 bytes'); +ASSERT( write_file(File::Spec->catfile($root,'FSWP_TEST_REF.TMP'), {buf_ref => \$o}) , 'write file - string reference 1e5 bytes'); my $refString; -read_file("$root/FSWP_TEST_REF", buf_ref => \$refString); +read_file(File::Spec->catfile($root,'FSWP_TEST_REF.TMP'), buf_ref => \$refString); TRACE("length = ".length($refString)); ASSERT( (ref \$refString eq 'SCALAR'), 'right reference type'); ASSERT( (length($refString) == 100000), 'correct length'); @@ -67,8 +70,8 @@ # testing the list-context read. my @list; $o = "line1$/line2$/line3$/line4$/line5$/"; -ASSERT( write_file("$root/FSWP_TEST_LIST", $o) , 'write file - multiline'); -eval q{ @list = read_file("$root/FSWP_TEST_LIST");}; +ASSERT( write_file(File::Spec->catfile($root,'FSWP_TEST_LIST.TMP'), $o) , 'write file - multiline'); +eval q{ @list = read_file(File::Spec->catfile($root,'FSWP_TEST_LIST.TMP'));}; DUMP(\@list); ASSERT( (! $@) , 'read back list - eval outcome'); ASSERT( ($#list > 0) , 'read back list - has array filled'); @@ -78,42 +81,48 @@ # now let's check we don't have any nasty block IO problems # big file $o = (int(rand(1000)) . int(rand(1000)) . int(rand(1000)) . int(rand(1000))) x 5000; -ASSERT( write_file("$root/FSWP_TEST_BLOCK", \$o) , 'write file - block'); -ASSERT( $i = read_file("$root/FSWP_TEST_BLOCK") , 'read back'); +ASSERT( write_file(File::Spec->catfile($root,'FSWP_TEST_BLOCK.TMP'), \$o) , 'write file - block'); +ASSERT( $i = read_file(File::Spec->catfile($root,'FSWP_TEST_BLOCK.TMP')) , 'read back'); ASSERT( ($i eq $o) , 'ensure data matches'); #################################################################### # appending to file, with gratuitious pause $o = (int(rand(1000)) . int(rand(1000)) . int(rand(1000)) . int(rand(1000))) x 250; -ASSERT( append_file("$root/FSWP_TEST_APPEND", \$o) , 'append file - many times'); +ASSERT( append_file(File::Spec->catfile($root,'FSWP_TEST_APPEND.TMP'), \$o) , 'append file - many times'); for (2..10) { - append_file("$root/FSWP_TEST_APPEND", \$o); + append_file(File::Spec->catfile($root,'FSWP_TEST_APPEND.TMP'), \$o); } sleep(1); for (11..20) { - append_file("$root/FSWP_TEST_APPEND", \$o); + append_file(File::Spec->catfile($root,'FSWP_TEST_APPEND.TMP'), \$o); } -ASSERT( ($i = read_file("$root/FSWP_TEST_APPEND")) , 'read back'); +ASSERT( ($i = read_file(File::Spec->catfile($root,'FSWP_TEST_APPEND.TMP'))) , 'read back'); ASSERT( ($i eq ($o x 20)) , 'ensure data matches'); #################################################################### # Reading directories -@list = grep /^FSWP/, sort &read_dir($root); +@list = grep /^FSWP/i, sort &read_dir($root); DUMP(\@list); +if($^O eq 'VMS'){ + @list = map {uc} @list; +} ASSERT(EQUAL( \@list, [ - 'FSWP_TEST', - 'FSWP_TEST_APPEND', - 'FSWP_TEST_BLOCK', - 'FSWP_TEST_LIST', - 'FSWP_TEST_REF', + 'FSWP_TEST.TMP', + 'FSWP_TEST_APPEND.TMP', + 'FSWP_TEST_BLOCK.TMP', + 'FSWP_TEST_LIST.TMP', + 'FSWP_TEST_REF.TMP', ]), "read_dir"); #################################################################### # test error conditions -ASSERT( DIED(sub { read_file("$root/FSWP_Icon\r"); } ), 'bad chars' ); -ASSERT( DIED(sub { read_file("$root/FSWP_NONEXISTENT"); } ), 'doesnt exist' ); +ASSERT( DIED(sub { read_file(File::Spec->catfile($root,"FSWP_Icon\r")); } ), 'bad chars' ); +ASSERT( DIED(sub { read_file(File::Spec->catfile($root,'FSWP_NONEXISTENT')); } ), 'doesnt exist' ); #################################################################### # cleanup -unlink("$root/FSWP_TEST", "$root/FSWP_TEST_LIST", "$root/FSWP_TEST_REF", "$root/FSWP_TEST_BLOCK", "$root/FSWP_TEST_APPEND") unless ($opt_s); - +if(! $opt_s){ + foreach my $tmp_file (@tmp_files) { + 1 while unlink(File::Spec->catfile($root,$tmp_file)); + } +}