Anonymous avatar Anonymous committed 1b4b3ff

Test-Harness-NG:

* Added a test to test against the presence of the per-test-file
statistics report. (implemnetd using formats for the time being.)

Comments (0)

Files changed (3)

modules/Test-Shlomif-Harness/Changes

     * Fixed a documentation problem with the test_files passed as an argument
     to runtests.
+    * Added a test to test against the presence of the per-test-file
+    statistics report. (implemnetd using formats for the time being.)
 
 0.0100_02 Mon Oct 31 00:37:26 IST 2005
     * Changed the string Test::Harness to Test::Shlomif::Harness in 

modules/Test-Shlomif-Harness/lib/Test/Shlomif/Harness/Obj.pm

     my $self = shift;
     my (%args) = @_;
 
-    my $tests = $self->test_files();
-
     _autoflush(\*STDOUT);
     _autoflush(\*STDERR);
 
     $self->_init_dir_files();
     my $run_start_time = new Benchmark;
 
-    $self->width($self->_leader_width('test_files' => $tests));
-    foreach my $tfile (@$tests) 
+    $self->width($self->_leader_width());
+    foreach my $tfile (@{$self->test_files()}) 
     {
         $self->_run_single_test('test_file' => $tfile);
     } # foreach test
 =cut
 
 sub _leader_width {
-    my ($self, %args) = @_;
-    my $tests = $args{test_files};
+    my ($self) = @_;
+    my $tests = $self->test_files();
 
     my $maxlen = 0;
     my $maxsuflen = 0;
         );
 }
 
+sub _create_fmts {
+    my $self = shift;
+    my $failedtests = $self->failed_tests();
+
+    my $failed_str = "Failed Test";
+    my $middle_str = " Stat Wstat Total Fail  Failed  ";
+    my $list_str = "List of Failed";
+
+    # Figure out our longest name string for formatting purposes.
+    my $max_namelen = length($failed_str);
+    foreach my $script (keys %$failedtests) {
+        my $namelen = length $failedtests->{$script}->{name};
+        $max_namelen = $namelen if $namelen > $max_namelen;
+    }
+
+    my $list_len = $Columns - length($middle_str) - $max_namelen;
+    if ($list_len < length($list_str)) {
+        $list_len = length($list_str);
+        $max_namelen = $Columns - length($middle_str) - $list_len;
+        if ($max_namelen < length($failed_str)) {
+            $max_namelen = length($failed_str);
+            $Columns = $max_namelen + length($middle_str) + $list_len;
+        }
+    }
+
+    my $fmt_top = "format STDOUT_TOP =\n"
+                  . sprintf("%-${max_namelen}s", $failed_str)
+                  . $middle_str
+                  . $list_str . "\n"
+                  . "-" x $Columns
+                  . "\n.\n";
+
+    my $fmt = "format STDOUT =\n"
+              . "@" . "<" x ($max_namelen - 1)
+              . "  @>> @>>>> @>>>> @>>> ^##.##%  "
+              . "^" . "<" x ($list_len - 1) . "\n"
+              . '{ $Curtest->{name}, $Curtest->{estat},'
+              . '  $Curtest->{wstat}, $Curtest->{max},'
+              . '  $Curtest->{failed}, $Curtest->{percent},'
+              . '  $Curtest->{canon}'
+              . "\n}\n"
+              . "~~" . " " x ($Columns - $list_len - 2) . "^"
+              . "<" x ($list_len - 1) . "\n"
+              . '$Curtest->{canon}'
+              . "\n.\n";
+
+    eval $fmt_top;
+    die $@ if $@;
+    eval $fmt;
+    die $@ if $@;
+
+    return($fmt_top, $fmt);
+}
+
 sub _fail_other
 {
     my $self = shift;
 
     my $subpct = $self->_get_sub_percent_msg();
 
+    $self->_create_fmts();
+
     # Now write to formats
     for my $script (sort keys %$failed_tests) {
       $Curtest = $failed_tests->{$script};
       write;
     }
     if ($tot->{bad}) {
-        my $bonusmsg = $self->_bonusmsg();
+        my $bonusmsg = $self->_bonusmsg() || "";
         $bonusmsg =~ s/^,\s*//;
         if ($bonusmsg)
         {

modules/Test-Shlomif-Harness/t/test-failure-report.t

+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+use File::Spec;
+
+my $Curdir = File::Spec->curdir;
+my $SAMPLE_TESTS = $ENV{PERL_CORE}
+                    ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
+                    : File::Spec->catdir($Curdir, 't',   'sample-tests');
+
+
+use Test::More tests => 1;;
+
+my $IsMacPerl = $^O eq 'MacOS';
+my $IsVMS     = $^O eq 'VMS';
+
+# VMS uses native, not POSIX, exit codes.
+# MacPerl's exit codes are broken.
+my $die_estat = $IsVMS     ? 44 : 
+                $IsMacPerl ? 0  :
+                             1;
+
+use Test::Shlomif::Harness::Obj;
+
+
+open ALTOUT, ">", "altout.txt";
+open SAVEOUT, ">&STDOUT";
+open STDOUT, ">&ALTOUT";
+    
+my $tester = Test::Shlomif::Harness::Obj->new(
+    test_files => ["t/sample-tests/simple_fail"]
+    );
+eval {
+$tester->runtests();
+};
+
+open STDOUT, ">&SAVEOUT";
+close(SAVEOUT);
+close(ALTOUT);
+my $text = do { local $/; open I, "<", "altout.txt"; <I>};
+my $right_text = <<"EOF";
+t/sample-tests/simple_fail...FAILED tests 2, 5
+	Failed 2/5 tests, 60.00% okay
+Failed Test                Stat Wstat Total Fail  Failed  List of Failed
+-------------------------------------------------------------------------------
+t/sample-tests/simple_fail                5    2  40.00%  2 5
+EOF
+# TEST
+is ($text, $right_text, "Testing for the right failure text");
+
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.