In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/61fc5122f0d8a509834282b8ecb3252d2e4c9f5d?hp=7f40cf6b25ea33d8a2dbbe1b42267811532b235d>
- Log -----------------------------------------------------------------
commit 61fc5122f0d8a509834282b8ecb3252d2e4c9f5d
Author: Karl Williamson <k...@khw-desktop.(none)>
Date: Fri Nov 20 11:02:01 2009 -0700
Make unicode semantics the default
-----------------------------------------------------------------------
Summary of changes:
lib/legacy.pm | 6 +++---
lib/legacy.t | 32 ++++++++++++++------------------
perl.h | 2 +-
t/uni/overload.t | 4 ++++
utf8.h | 3 ++-
5 files changed, 24 insertions(+), 23 deletions(-)
diff --git a/lib/legacy.pm b/lib/legacy.pm
index 66ddc00..67f287f 100755
--- a/lib/legacy.pm
+++ b/lib/legacy.pm
@@ -2,7 +2,7 @@ package legacy;
our $VERSION = '1.00';
-$unicode8bit::hint_uni8bit = 0x00000800;
+$unicode8bit::hint_not_uni8bit = 0x00000800;
my %legacy_bundle = (
"5.10" => [qw(unicode8bit)],
@@ -156,7 +156,7 @@ sub import {
if (!exists $legacy{$name}) {
unknown_legacy($name);
}
- $^H &= ~$unicode8bit::hint_uni8bit; # The only valid thing as of yet
+ $^H |= $unicode8bit::hint_not_uni8bit; # The only valid thing as of
yet
}
}
@@ -179,7 +179,7 @@ sub unimport {
unknown_legacy($name);
}
else {
- $^H |= $unicode8bit::hint_uni8bit; # The only valid thing as of yet
+ $^H &= ~ $unicode8bit::hint_not_uni8bit; # The only valid thing now
}
}
}
diff --git a/lib/legacy.t b/lib/legacy.t
index 1d332b7..1f0cce9 100644
--- a/lib/legacy.t
+++ b/lib/legacy.t
@@ -7,10 +7,9 @@ BEGIN {
require './test.pl';
}
-#use Test::More;
+plan(13312); # Determined by experimentation
-#plan("no_plan");
-plan(13312);
+# Test the upper/lower/title case mappings for all characters 0-255.
# First compute the case mappings without resorting to the functions we're
# testing.
@@ -28,7 +27,7 @@ my @posix_to_lower
= @posix_to_upper;
# Override the elements in the to_lower arrays that have different lower case
-# mappings with those mappings.
+# mappings
for my $i (0x41 .. 0x5A) {
$posix_to_lower[$i] = chr(ord($posix_to_lower[$i]) + 32);
$latin1_to_lower[$i] = chr(ord($latin1_to_lower[$i]) + 32);
@@ -82,12 +81,12 @@ $empty{'lc'} = $empty{'uc'} = "";
for my $prefix (\%empty, \%posix, \%cyrillic, \%latin1) {
for my $suffix (\%empty, \%posix, \%cyrillic, \%latin1) {
for my $i (0 .. 255) { # For each possible posix or latin1 character
- my $cp = sprintf "%02X", $i;
+ my $cp = sprintf "U+%04X", $i;
# First try using latin1 (Unicode) semantics.
no legacy "unicode8bit";
- my $phrase = 'with unicode';
+ my $phrase = 'with uni8bit';
my $char = chr($i);
my $pre_lc = $prefix->{'lc'};
my $pre_uc = $prefix->{'uc'};
@@ -99,25 +98,22 @@ for my $prefix (\%empty, \%posix, \%cyrillic, \%latin1) {
my $expected_lower = $pre_lc . $latin1_to_lower[$i] . $post_lc;
is (uc($to_upper), $expected_upper,
-
- # The names are commented out for now to avoid 'wide character
- # in print' messages.
- ); #"$cp: $phrase: uc('$to_upper') eq '$expected_upper'");
+ display("$cp: $phrase: uc($to_upper) eq $expected_upper"));
is (lc($to_lower), $expected_lower,
- ); #"$cp: $phrase: lc('$to_lower') eq '$expected_lower'");
+ display("$cp: $phrase: lc($to_lower) eq $expected_lower"));
if ($pre_uc eq "") { # Title case if null prefix.
my $expected_title = $latin1_to_title[$i] . $post_lc;
is (ucfirst($to_upper), $expected_title,
- ); #"$cp: $phrase: ucfirst('$to_upper') eq
'$expected_title'");
+ display("$cp: $phrase: ucfirst($to_upper) eq
$expected_title"));
my $expected_lcfirst = $latin1_to_lower[$i] . $post_uc;
is (lcfirst($to_lower), $expected_lcfirst,
- ); #"$cp: $phrase: lcfirst('$to_lower') eq
'$expected_lcfirst'");
+ display("$cp: $phrase: lcfirst($to_lower) eq
$expected_lcfirst"));
}
# Then try with posix semantics.
use legacy "unicode8bit";
- $phrase = 'no unicode';
+ $phrase = 'no uni8bit';
# These don't contribute anything in this case.
next if $suffix == \%cyrillic;
@@ -129,17 +125,17 @@ for my $prefix (\%empty, \%posix, \%cyrillic, \%latin1) {
$expected_lower = $pre_lc . $posix_to_lower[$i] . $post_lc;
is (uc($to_upper), $expected_upper,
- ); #"$cp: $phrase: uc('$to_upper') eq '$expected_upper'");
+ display("$cp: $phrase: uc($to_upper) eq $expected_upper"));
is (lc($to_lower), $expected_lower,
- ); #"$cp: $phrase: lc('$to_lower') eq '$expected_lower'");
+ display("$cp: $phrase: lc($to_lower) eq $expected_lower"));
if ($pre_uc eq "") {
my $expected_title = $posix_to_title[$i] . $post_lc;
is (ucfirst($to_upper), $expected_title,
- ); #"$cp: $phrase: ucfirst('$to_upper') eq
'$expected_title'");
+ display("$cp: $phrase: ucfirst($to_upper) eq
$expected_title"));
my $expected_lcfirst = $posix_to_lower[$i] . $post_uc;
is (lcfirst($to_lower), $expected_lcfirst,
- ); #"$cp: $phrase: lcfirst('$to_lower') eq
'$expected_lcfirst'");
+ display("$cp: $phrase: lcfirst($to_lower) eq
$expected_lcfirst"));
}
}
}
diff --git a/perl.h b/perl.h
index 38c9664..bf49279 100644
--- a/perl.h
+++ b/perl.h
@@ -4755,7 +4755,7 @@ enum { /* pass one of these to get_vtbl */
#define HINT_BLOCK_SCOPE 0x00000100
#define HINT_STRICT_SUBS 0x00000200 /* strict pragma */
#define HINT_STRICT_VARS 0x00000400 /* strict pragma */
-#define HINT_UNI_8_BIT 0x00000800 /* unicode8bit pragma */
+#define HINT_NOT_UNI_8_BIT 0x00000800 /* unicode8bit pragma */
/* The HINT_NEW_* constants are used by the overload pragma */
#define HINT_NEW_INTEGER 0x00001000
diff --git a/t/uni/overload.t b/t/uni/overload.t
index e20a3ab..da9b07b 100644
--- a/t/uni/overload.t
+++ b/t/uni/overload.t
@@ -33,6 +33,10 @@ sub stringify {
package main;
+# These tests are based on characters 128-255 not having latin1, and hence
+# Unicode, semantics
+use legacy 'unicode8bit';
+
# Bug 34297
foreach my $t ("ASCII", "B\366se") {
my $length = length $t;
diff --git a/utf8.h b/utf8.h
index 7c205d1..19f2174 100644
--- a/utf8.h
+++ b/utf8.h
@@ -207,7 +207,8 @@ encoded character.
#define IN_BYTES (CopHINTS_get(PL_curcop) & HINT_BYTES)
#define DO_UTF8(sv) (SvUTF8(sv) && !IN_BYTES)
-#define IN_UNI_8_BIT (CopHINTS_get(PL_curcop) & HINT_UNI_8_BIT && !
IN_LOCALE_RUNTIME && ! IN_BYTES)
+#define IN_UNI_8_BIT ( (! (CopHINTS_get(PL_curcop) & HINT_NOT_UNI_8_BIT)) \
+ && ! IN_LOCALE_RUNTIME && ! IN_BYTES)
#define UTF8_ALLOW_EMPTY 0x0001
#define UTF8_ALLOW_CONTINUATION 0x0002
--
Perl5 Master Repository
