aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Perl/t/TestLog.pm35
1 files changed, 21 insertions, 14 deletions
diff --git a/Perl/t/TestLog.pm b/Perl/t/TestLog.pm
index e50374a..6c84604 100644
--- a/Perl/t/TestLog.pm
+++ b/Perl/t/TestLog.pm
@@ -6,39 +6,46 @@ package TestLog;
use IO::Handle; # for autoflushing the logs
use Carp;
-use strict;
+use Exporter;
+@ISA = qw(Exporter);
-use vars qw( $VERSION @ISA @EXPORT );
+use vars qw( $VERSION @ISA);
($VERSION) = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
@EXPORT = qw( openLog setZincLog log test_eval test_no_eval printableItem printableArray printableList
equal_flat_arrays nequal_cplx_arrays);
+use strict;
use constant ERROR => '--an error--';
-my $opt_log;
+my $selected_loglevel;
+
sub openLog {
- my ($outfile);
- ($outfile,$opt_log) = @_;
+ my ($outfile, $loglevel, $no_logfile) = @_;
-
- if ( open LOG, "$outfile.prev" ) {
+ $selected_loglevel = $loglevel;
+ if (defined $no_logfile && $no_logfile) {
+ open LOG, "> /dev/null";
+ }
+ else {
+ if ( open LOG, "$outfile.prev" ) {
close LOG;
unlink "$outfile.prev";
- }
- if ( open LOG, $outfile ) {
+ }
+ if ( open LOG, $outfile ) {
close LOG;
link $outfile, "$outfile.prev";
unlink "$outfile";
+ }
+
+ open LOG,"> $outfile";
+ autoflush LOG 1; # autoflush is important so that logs are up-to-date if Zinc crashes!
}
-
- open LOG,">$outfile";
- autoflush LOG 1; # autoflush is important so that logs are up-to-date if Zinc crashes!
}
### print log information to the logfile
-### if $level is <= than opt_log (def = 0) then print log on the stdout
+### if $level is <= than selected_loglevel (def = 0) then print log on the stdout
### - a loglevel of -100 means an error to be logged with #### prefix
### - a loglevel of -10 means an error in the test to be logged with ## prefix
### - a loglevel of 0 means an message to be usually printed (and logged in any case)
@@ -47,7 +54,7 @@ sub openLog {
sub log {
my ($loglevel, @strgs) = @_;
- if ($loglevel <= $opt_log) {
+ if ($loglevel <= $selected_loglevel) {
print "#### " if $loglevel == -100;
print "## " if $loglevel == -10;
print @strgs;