Commits

shl...@52c325ad-5fd0-0310-8a0f-c43feede02cc  committed 9f76723

Eliminated the STDOUT format with my own code.

  • Participants
  • Parent commits 8173c94

Comments (0)

Files changed (2)

File 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.)
+    statistics report. (implemented using formats for the time being.)
+    * Eliminated the use of formats in the fail_other report(). Made a lot
+    of refactoring up to the point.
 
 0.0100_02 Mon Oct 31 00:37:26 IST 2005
     * Changed the string Test::Harness to Test::Shlomif::Harness in 

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

     @ISA @EXPORT_OK 
     $Switches
     $switches
-    $Curtest
     $Columns 
     $has_time_hires
 );
     $self->_print_message("-" x $Columns);
 }
 
+sub _fail_other_get_canon_strings
+{
+    my $self = shift;
+    my $canon = shift;
+    my @ret = ();
+    my $string = shift(@$canon);
+    while (@$canon)
+    {
+        if (length($canon->[0]) + 1 + length($string)< $self->list_len())
+        {
+            $string .= " ".shift(@$canon);
+        }
+        else
+        {
+            push @ret, $string;
+            $string = shift(@$canon);
+        }
+    }
+    push @ret, $string;
+    return \@ret;
+}
+
+sub _fail_other_print_test
+{
+    my $self = shift;
+    my $script = shift;
+    my $test = $self->failed_tests()->{$script};
+
+    my $max_namelen = $self->max_namelen();
+    my $list_len = $self->list_len();
+
+    my @canon = split(/\s+/, $test->{canon});
+
+    my $canon_strings = $self->_fail_other_get_canon_strings([@canon]);
+    
+    $self->_print_message(
+        sprintf(
+            ("%-" . $max_namelen . "s  " . 
+                "%3s %5s %5s %4s %6.2f%%  %s"),
+            $test->{name}, $test->{estat},
+            $test->{wstat}, $test->{max},
+            $test->{failed}, $test->{percent},
+            shift(@$canon_strings)
+        )
+    );
+    foreach my $c (@$canon_strings)
+    {
+        $self->_print_message(
+            sprintf((" " x ($Columns - $list_len) . 
+                "%s"),
+                $c
+            ),
+        );
+    }
+}
+
 sub _create_fmts {
     my $self = shift;
     my $failedtests = $self->failed_tests();
-   
+
     $self->_calc_format_widths();
-    my $max_namelen = $self->max_namelen();
-    my $list_len = $self->list_len();
-
-=begin comment
-
-    my $fmt_top = "format STDOUT_TOP =\n"
-                  . sprintf("%-${max_namelen}s", $self->_get_format_failed_str())
-                  . $self->_get_format_middle_str()
-                  . $self->_get_format_list_str() . "\n"
-                  . "-" x $Columns
-                  . "\n.\n";
-
-=end comment
-
-=cut
-    
-    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;
-    die $@ if $@;
 
     return 0;
 }
 
     # Now write to formats
     for my $script (sort keys %$failed_tests) {
-      $Curtest = $failed_tests->{$script};
-      write;
+      $self->_fail_other_print_test($script);
     }
     if ($tot->{bad}) {
         my $bonusmsg = $self->_bonusmsg() || "";