aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormertz2005-01-16 10:27:35 +0000
committermertz2005-01-16 10:27:35 +0000
commita3d6f9cf8c4b2212ad9482619a14c0726a6ea017 (patch)
treea9b3d7ffd2e65d8a5f7ebfa84644a540e34f3c70
parentd95df63ceb120cde92eb9d1015427bd847f474eb (diff)
downloadtkzinc-a3d6f9cf8c4b2212ad9482619a14c0726a6ea017.zip
tkzinc-a3d6f9cf8c4b2212ad9482619a14c0726a6ea017.tar.gz
tkzinc-a3d6f9cf8c4b2212ad9482619a14c0726a6ea017.tar.bz2
tkzinc-a3d6f9cf8c4b2212ad9482619a14c0726a6ea017.tar.xz
- adding a 3rd param to the openLog function so that the log file
can be diverted to /dev/null
-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;