Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
testpods	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
contains_bad_pod.xr	31 B	-r--r--r--	2014-12-27 11:48
contains_pod.t	306 B	-r--r--r--	2014-12-27 11:48
contains_pod.xr	32 B	-r--r--r--	2014-12-27 11:48
empty.xr	0 B	-r--r--r--	2014-12-27 11:48
emptycmd.t	422 B	-r--r--r--	2014-12-27 11:48
emptycmd.xr	58 B	-r--r--r--	2014-12-27 11:48
find.t	2.82 KB	-r--r--r--	2014-12-27 11:48
for.t	945 B	-r--r--r--	2014-12-27 11:48
for.xr	390 B	-r--r--r--	2014-12-27 11:48
headings.t	4.23 KB	-r--r--r--	2014-12-27 11:48
headings.xr	1.03 KB	-r--r--r--	2014-12-27 11:48
include.t	884 B	-r--r--r--	2014-12-27 11:48
include.xr	743 B	-r--r--r--	2014-12-27 11:48
included.t	1.02 KB	-r--r--r--	2014-12-27 11:48
included.xr	126 B	-r--r--r--	2014-12-27 11:48
lref.t	1.21 KB	-r--r--r--	2014-12-27 11:48
lref.xr	941 B	-r--r--r--	2014-12-27 11:48
multiline_items.t	537 B	-r--r--r--	2014-12-27 11:48
multiline_items.xr	147 B	-r--r--r--	2014-12-27 11:48
nested_items.t	760 B	-r--r--r--	2014-12-27 11:48
nested_items.xr	310 B	-r--r--r--	2014-12-27 11:48
nested_seqs.t	480 B	-r--r--r--	2014-12-27 11:48
nested_seqs.xr	114 B	-r--r--r--	2014-12-27 11:48
oneline_cmds.t	1.41 KB	-r--r--r--	2014-12-27 11:48
oneline_cmds.xr	1.03 KB	-r--r--r--	2014-12-27 11:48
podselect.t	381 B	-r--r--r--	2014-12-27 11:48
podselect.xr	1.52 KB	-r--r--r--	2014-12-27 11:48
selfcheck.t	1.25 KB	-r--r--r--	2014-12-27 11:48
special_seqs.t	1.46 KB	-r--r--r--	2014-12-27 11:48
special_seqs.xr	1.08 KB	-r--r--r--	2014-12-27 11:48
testcmp.pl	2.76 KB	-r--r--r--	2014-12-27 11:48
testp2pt.pl	5.63 KB	-r--r--r--	2014-12-27 11:48
testpchk.pl	3.58 KB	-r--r--r--	2014-12-27 11:48
twice.t	643 B	-r--r--r--	2014-12-27 11:48

Rename

package TestPodChecker;

BEGIN {
   use File::Basename;
   use File::Spec;
   push @INC, '..';
   my $THISDIR = dirname $0;
   unshift @INC, $THISDIR;
   require "testcmp.pl";
   import TestCompare;
   my $PARENTDIR = dirname $THISDIR;
   push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR);
   require VMS::Filespec if $^O eq 'VMS';
}

use Pod::Checker;
use vars qw(@ISA @EXPORT $MYPKG);
#use strict;
#use diagnostics;
use Carp;
use Exporter;
#use File::Compare;

@ISA = qw(Exporter);
@EXPORT = qw(&testpodchecker);
@EXPORT_OK = qw(&testpodcheck);
$MYPKG = eval { (caller)[0] };

sub stripname( $ ) {
   local $_ = shift;
   return /(\w[.\w]*)\s*$/ ? $1 : $_;
}

sub msgcmp( $ $ ) {
   ## filter out platform-dependent aspects of error messages
   my ($line1, $line2) = @_;
   for ($line1, $line2) {
      ## remove filenames from error messages to avoid any
      ## filepath naming differences between OS platforms
      s/(at line \S+ in file) .*\W(\w+\.[tT])\s*$/$1 \L$2\E/;
      s/.*\W(\w+\.[tT]) (has \d+ pod syntax error)/\L$1\E $2/;
   }
   return ($line1 ne $line2);
}

sub testpodcheck( @ ) {
   my %args = @_;
   my $infile  = $args{'-In'}  || croak "No input file given!";
   my $outfile = $args{'-Out'} || croak "No output file given!";
   my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!";

my $different = '';
   my $testname = basename $infile, '.t', '.xr';

unless (-e $cmpfile) {
      my $msg = "*** Can't find comparison file $cmpfile for testing $infile";
      warn  "$msg\n";
      return  $msg;
   }

print "# Running podchecker for '$testname'...\n";
   ## Compare the output against the expected result
   if ($^O eq 'VMS') {
      for ($infile, $outfile, $cmpfile) {
         $_ = VMS::Filespec::unixify($_)  unless  ref;
      }
   }
   podchecker($infile, $outfile);
   if ( testcmp({'-cmplines' => \&msgcmp}, $outfile, $cmpfile) ) {
       $different = "$outfile is different from $cmpfile";
   }
   else {
       unlink($outfile);
   }
   return  $different;
}

sub testpodchecker( @ ) {
   my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : ();
   my @testpods = @_;
   my ($testname, $testdir) = ("", "");
   my ($podfile, $cmpfile) = ("", "");
   my ($outfile, $errfile) = ("", "");
   my $passes = 0;
   my $failed = 0;
   local $_;

print "1..", scalar @testpods, "\n"  unless ($opts{'-xrgen'});

for $podfile (@testpods) {
      ($testname, $_) = fileparse($podfile);
      $testdir ||=  $_;
      $testname  =~ s/\.t$//;
      $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\"" .
                   " podchecker test ...\n";
             podchecker($podfile, $cmpfile);
          }
          else {
             print "# File $cmpfile already exists" .
                   " (use '-force' to regenerate it).\n";
          }
          next;
      }

my $failmsg = testpodcheck
                        -In  => $podfile,
                        -Out => $outfile,
                        -Cmp => $cmpfile;
      if ($failmsg) {
          ++$failed;
          print "#\tFAILED. ($failmsg)\n";
	  print "not ok ", $failed+$passes, "\n";
      }
      else {
          ++$passes;
          unlink($outfile);
          print "#\tPASSED.\n";
	  print "ok ", $failed+$passes, "\n";
      }
   }
   return  $passes;
}