Re: the remaining bugs in \x escapes (was Re: [PATCH] oct and hex in glorious 64...
[p5sagit/p5-mst-13.2.git] / t / pod / testp2pt.pl
index d917ad9..735350f 100644 (file)
@@ -32,6 +32,7 @@ BEGIN {
        require Pod::PlainText;
        @ISA = qw( Pod::PlainText );
     }
+    require VMS::Filespec if $^O eq 'VMS';
 }
 
 ## Hardcode settings for TERMCAP and COLUMNS so we can try to get
@@ -41,14 +42,19 @@ BEGIN {
 sub catfile(@) { File::Spec->catfile(@_); }
 
 my $INSTDIR = abs_path(dirname $0);
-$INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'xtra');
+if ($^O eq 'VMS') { # clean up directory spec
+    $INSTDIR = VMS::Filespec::unixpath($INSTDIR);
+    $INSTDIR =~ s#/$##;
+    $INSTDIR =~ s#/000000/#/#;
+}
 $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod');
 $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't');
 my @PODINCDIRS = ( catfile($INSTDIR, 'lib', 'Pod'),
                    catfile($INSTDIR, 'scripts'),
-                   catfile($INSTDIR, 't', 'pod'),
-                   catfile($INSTDIR, 't', 'pod', 'xtra')
+                   catfile($INSTDIR, 'pod'),
+                   catfile($INSTDIR, 't', 'pod')
                  );
+print "PODINCDIRS = ",join(', ',@PODINCDIRS),"\n";
 
 ## Find the path to the file to =include
 sub findinclude {
@@ -97,10 +103,14 @@ sub command {
     print $out_fh "###### end =include $incbase #####\n"    if ($incdebug);
 }
 
+sub begin_input {
+   $_[0]->{_INFILE} = VMS::Filespec::unixify($_[0]->{_INFILE}) if $^O eq 'VMS';
+}
+
 sub podinc2plaintext( $ $ ) {
     my ($infile, $outfile) = @_;
     local $_;
-    my $text_parser = $MYPKG->new;
+    my $text_parser = $MYPKG->new(quotes => "`'");
     $text_parser->parse_from_file($infile, $outfile);
 }
 
@@ -119,7 +129,7 @@ sub testpodinc2plaintext( @ ) {
       return  $msg;
    }
 
-   print "+ Running testpodinc2plaintext for '$testname'...\n";
+   print "# Running testpodinc2plaintext for '$testname'...\n";
    ## Compare the output against the expected result
    podinc2plaintext($infile, $outfile);
    if ( testcmp($outfile, $cmpfile) ) {
@@ -146,19 +156,19 @@ sub testpodplaintext( @ ) {
    for $podfile (@testpods) {
       ($testname, $_) = fileparse($podfile);
       $testdir ||=  $_;
-      $testname  =~ s/\.t$//;
+      $testname  =~ s/\..*$//;
       $cmpfile   =  $testdir . $testname . '.xr';
       $outfile   =  $testdir . $testname . '.OUT';
 
       if ($opts{'-xrgen'}) {
           if ($opts{'-force'} or ! -e $cmpfile) {
              ## Create the comparison file
-             print "+ Creating expected result for \"$testname\"" .
+             print "# Creating expected result for \"$testname\"" .
                    " pod2plaintext test ...\n";
              podinc2plaintext($podfile, $cmpfile);
           }
           else {
-             print "+ File $cmpfile already exists" .
+             print "# File $cmpfile already exists" .
                    " (use '-force' to regenerate it).\n";
           }
           next;
@@ -170,13 +180,13 @@ sub testpodplaintext( @ ) {
                         -Cmp => $cmpfile;
       if ($failmsg) {
           ++$failed;
-          print "+\tFAILED. ($failmsg)\n";
+          print "#\tFAILED. ($failmsg)\n";
          print "not ok ", $failed+$passes, "\n";
       }
       else {
           ++$passes;
           unlink($outfile);
-          print "+\tPASSED.\n";
+          print "#\tPASSED.\n";
          print "ok ", $failed+$passes, "\n";
       }
    }