develooper Front page | perl.perl5.porters | Postings from January 2001

PATCH pragma/locale.t

From:
andreas.koenig
Date:
January 18, 2001 00:45
Subject:
PATCH pragma/locale.t
Message ID:
m3lms98czy.fsf@ak-71.mind.de
This seems a *tiny* improvement for locale.t. As it was, the test spit
out too much noise with little chance to customize the output. With
this patch it drops some uninteresting messages, prints less spaces
and makes the interesting messages customizable.

--- pragma/locale.t@8472	Thu Jan 18 08:50:28 2001
+++ pragma/locale.t	Thu Jan 18 09:23:57 2001
@@ -15,8 +15,18 @@
 
 my $debug = 1;
 
+use Dumpvalue;
+
+my $dumper = Dumpvalue->new(
+                            tick => qq{"},
+                            quoteHighBit => 0,
+                            unctrl => "quote"
+                           );
 sub debug {
-    print @_ if $debug;
+  return unless $debug;
+  my($mess) = join "", @_;
+  chop $mess;
+  print $dumper->stringify($mess,1), "\n";
 }
 
 sub debugf {
@@ -428,8 +438,6 @@
 
 sub tryneoalpha {
     my ($Locale, $i, $test) = @_;
-    debug "# testing $i with locale '$Locale'\n"
-	unless $Testing{$i}{$Locale}++;
     unless ($test) {
 	$Problem{$i}{$Locale} = 1;
 	debug "# failed $i with locale '$Locale'\n";
@@ -441,7 +449,7 @@
 foreach $Locale (@Locale) {
     debug "# Locale = $Locale\n";
     @Alnum_ = getalnum_();
-    debug "# \\w = @Alnum_\n";
+    debug "# w = ", join("",@Alnum_), "\n";
 
     unless (setlocale(LC_ALL, $Locale)) {
 	foreach (99..103) {
@@ -476,9 +484,9 @@
 	delete $lower{$_};
     }
 
-    debug "# UPPER    = ", join(" ", sort keys %UPPER   ), "\n";
-    debug "# lower    = ", join(" ", sort keys %lower   ), "\n";
-    debug "# BoThCaSe = ", join(" ", sort keys %BoThCaSe), "\n";
+    debug "# UPPER    = ", join("", sort keys %UPPER   ), "\n";
+    debug "# lower    = ", join("", sort keys %lower   ), "\n";
+    debug "# BoThCaSe = ", join("", sort keys %BoThCaSe), "\n";
 
     # Find the alphabets that are not alphabets in the default locale.
 
@@ -494,7 +502,7 @@
 
     @Neoalpha = sort @Neoalpha;
 
-    debug "# Neoalpha = @Neoalpha\n";
+    debug "# Neoalpha = ", join("",@Neoalpha), "\n";
 
     if (@Neoalpha == 0) {
 	# If we have no Neoalphas the remaining tests are no-ops.
@@ -661,7 +669,6 @@
 	tryneoalpha($Locale, 114, $f == $c);
     }
 
-    debug "# testing 115 with locale '$Locale'\n";
     # Does taking lc separately differ from taking
     # the lc "in-line"?  (This was the bug 19990704.002, change #3568.)
     # The bug was in the caching of the 'o'-magic.
@@ -687,7 +694,6 @@
 		    lcA($x, $z) == 0 && lcB($x, $z) == 0);
     }
 
-    debug "# testing 116 with locale '$Locale'\n";
     # Does lc of an UPPER (if different from the UPPER) match
     # case-insensitively the UPPER, and does the UPPER match
     # case-insensitively the lc of the UPPER.  And vice versa.



-- 
andreas



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About