Change 20991 by [EMAIL PROTECTED] on 2003/09/02 04:39:23
Integrate:
[ 20978]
Subject: [EMAIL PROTECTED] some WinCE compilers require a little correction
From: Vadim Konovalov <[EMAIL PROTECTED]>
Date: Mon, 1 Sep 2003 02:57:33 +0400
Message-ID: <[EMAIL PROTECTED]>
[ 20979]
Ultrix VAX is like VMS VAX in floating point.
[ 20980]
Subject: glob() bug
From: Gurusamy Sarathy <[EMAIL PROTECTED]>
Date: Mon, 01 Sep 2003 02:25:41 -0700
Message-Id: <[EMAIL PROTECTED]>
[ 20981]
Subject: [DOC PATCH] perlfaq4.pod
Date: Mon, 1 Sep 2003 12:38:50 +0200
From: Elizabeth Mattijsen <[EMAIL PROTECTED]>
Message-Id: <[EMAIL PROTECTED]>
[ 20982]
Configure -r in AIX bad.
[ 20983]
From Craig Berry, following the example of the other podxxx.PL
in relying on basename($0, '.PL') to Do The Right Thing with
regard to the case of the extension, which could be either
.pl or .PL on VMS depending on version-specific features.
[ 20989]
Subject: [PATCH Porting/valgrindpp.pl] more options for valgrindpp.pl
From: "Marcus Holland-Moritz" <[EMAIL PROTECTED]>
Date: Mon, 1 Sep 2003 22:28:58 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 20990]
Upgrade to Unicode::Collate 0.27.
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#109 integrate
... //depot/maint-5.8/perl/Porting/valgrindpp.pl#2 integrate
... //depot/maint-5.8/perl/README.aix#6 integrate
... //depot/maint-5.8/perl/lib/Unicode/Collate.pm#6 integrate
... //depot/maint-5.8/perl/lib/Unicode/Collate/Changes#6 integrate
... //depot/maint-5.8/perl/lib/Unicode/Collate/README#6 integrate
... //depot/maint-5.8/perl/lib/Unicode/Collate/t/hangul.t#1 branch
... //depot/maint-5.8/perl/op.c#38 integrate
... //depot/maint-5.8/perl/pod/perlfaq4.pod#9 integrate
... //depot/maint-5.8/perl/pod/pod2usage.PL#4 integrate
... //depot/maint-5.8/perl/pod/podselect.PL#6 integrate
... //depot/maint-5.8/perl/t/op/sprintf.t#8 integrate
... //depot/maint-5.8/perl/t/run/fresh_perl.t#7 integrate
... //depot/maint-5.8/perl/wince/Makefile.ce#11 integrate
... //depot/maint-5.8/perl/wince/wince.c#8 integrate
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#109 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#108~20974~ Sun Aug 31 08:40:42 2003
+++ perl/MANIFEST Mon Sep 1 21:39:23 2003
@@ -1726,6 +1726,7 @@
lib/Unicode/Collate/keys.txt Unicode::Collate
lib/Unicode/Collate.pm Unicode::Collate
lib/Unicode/Collate/README Unicode::Collate
+lib/Unicode/Collate/t/hangul.t Unicode::Collate
lib/Unicode/Collate/t/index.t Unicode::Collate
lib/Unicode/Collate/t/test.t Unicode::Collate
lib/Unicode/README Explanation what happened to lib/unicode.
==== //depot/maint-5.8/perl/Porting/valgrindpp.pl#2 (text) ====
Index: perl/Porting/valgrindpp.pl
--- perl/Porting/valgrindpp.pl#1~20926~ Thu Aug 28 09:45:10 2003
+++ perl/Porting/valgrindpp.pl Mon Sep 1 21:39:23 2003
@@ -10,14 +10,20 @@
my %opt = (
frames => 3,
+ lines => 0,
+ tests => 0,
+ top => 0,
verbose => 0,
);
GetOptions(\%opt, qw(
dir=s
+ frames=i
hide=s@
+ lines!
output-file=s
- frames=i
+ tests!
+ top=i
verbose+
)) or pod2usage(2);
@@ -69,41 +75,114 @@
# Collect summary data
find({wanted => \&filter, no_chdir => 1}, $opt{dir});
+# Format the output nicely
+$Text::Wrap::columns = 80;
+$Text::Wrap::unexpand = 0;
+
# Write summary
-summary($fh);
+summary($fh, \%error, \%leak);
exit 0;
sub summary {
- my $fh = shift;
+ my($fh, $error, $leak) = @_;
+ my(%ne, %nl, %top);
+
+ # Prepare the data
+
+ for my $e (keys %$error) {
+ for my $f (keys %{$error->{$e}}) {
+ my($func, $file, $line) = split /:/, $f;
+ my $nf = $opt{lines} ? "$func ($file:$line)" : "$func ($file)";
+ $ne{$e}{$nf}{count}++;
+ while (my($k,$v) = each %{$error->{$e}{$f}}) {
+ $ne{$e}{$nf}{tests}{$k} += $v;
+ $top{$k}{error}++;
+ }
+ }
+ }
+
+ for my $l (keys %$leak) {
+ for my $s (keys %{$leak->{$l}}) {
+ my $ns = join '<', map {
+ my($func, $file, $line) = split /:/;
+ /:/ ? $opt{lines}
+ ? "$func ($file:$line)" : "$func ($file)"
+ : $_
+ } split /</, $s;
+ $nl{$l}{$ns}{count}++;
+ while (my($k,$v) = each %{$leak->{$l}{$s}}) {
+ $nl{$l}{$ns}{tests}{$k} += $v;
+ $top{$k}{leak}++;
+ }
+ }
+ }
+
+ # Print the Top N
+
+ if ($opt{top}) {
+ for my $what (qw(error leak)) {
+ my @t = sort { $top{$b}{$what} <=> $top{$a}{$what} or $a cmp $b }
+ grep $top{$_}{$what}, keys %top;
+ @t > $opt{top} and splice @t, $opt{top};
+ my $n = @t;
+ my $s = $n > 1 ? 's' : '';
+ my $prev = 0;
+ print $fh "Top $n test scripts for ${what}s:\n\n";
+ for my $i (1 .. $n) {
+ $n = $top{$t[$i-1]}{$what};
+ $s = $n > 1 ? 's' : '';
+ printf $fh " %3s %-40s %3d $what$s\n",
+ $n != $prev ? "$i." : '', $t[$i-1], $n;
+ $prev = $n;
+ }
+ print $fh "\n";
+ }
+ }
+
+ # Print the real summary
- $Text::Wrap::columns = 80;
-
print $fh "MEMORY ACCESS ERRORS\n\n";
-
- for my $e (sort keys %error) {
+
+ for my $e (sort keys %ne) {
print $fh qq("$e"\n);
- for my $frame (sort keys %{$error{$e}}) {
- print $fh ' 'x4, "$frame\n",
- wrap(' 'x8, ' 'x8, join ', ', sort keys %{$error{$e}{$frame}}),
- "\n";
+ for my $frame (sort keys %{$ne{$e}}) {
+ my $data = $ne{$e}{$frame};
+ my $count = $data->{count} > 1 ? " [$data->{count} paths]" : '';
+ print $fh ' 'x4, "$frame$count\n",
+ format_tests($data->{tests}), "\n";
}
print $fh "\n";
}
-
+
print $fh "\nMEMORY LEAKS\n\n";
-
- for my $l (sort keys %leak) {
+
+ for my $l (sort keys %nl) {
print $fh qq("$l"\n);
- for my $frames (sort keys %{$leak{$l}}) {
+ for my $frames (sort keys %{$nl{$l}}) {
+ my $data = $nl{$l}{$frames};
my @stack = split /</, $frames;
+ $data->{count} > 1 and $stack[-1] .= " [$data->{count} paths]";
print $fh join('', map { ' 'x4 . "$_:$stack[$_]\n" } 0 .. $#stack ),
- wrap(' 'x8, ' 'x8, join ', ', sort keys %{$leak{$l}{$frames}}),
- "\n\n";
+ format_tests($data->{tests}), "\n\n";
}
}
}
+sub format_tests {
+ my $tests = shift;
+ my $indent = ' 'x8;
+
+ if ($opt{tests}) {
+ return wrap($indent, $indent, join ', ', sort keys %$tests);
+ }
+ else {
+ my $count = keys %$tests;
+ my $s = $count > 1 ? 's' : '';
+ return $indent . "triggered by $count test$s";
+ }
+}
+
sub filter {
debug(2, "$File::Find::name\n");
@@ -139,18 +218,20 @@
my $inperl = 0; # Are we inside the perl source? (And how deep?)
my @stack; # Call stack
- while ($l[$j++] =~ /^\s+(?:at|by)
$hexaddr:\s+((\w+)\s+\((?:([^:]+:\d+)|[^)]+)\))/o) {
- my($frame, $func, $loc) = ($1, $2, $3);
+ while ($l[$j++] =~ /^\s+(?:at|by)
$hexaddr:\s+(\w+)\s+\((?:([^:]+):(\d+)|[^)]+)\)/o) {
+ my($func, $file, $lineno) = ($1, $2, $3);
# If the stack frame is inside perl => increment $inperl
# If we've already been inside perl, but are no longer => leave
- defined $loc && ++$inperl or $inperl && last;
+ defined $file && ++$inperl or $inperl && last;
# A function that should be hidden? => clear stack and leave
$hidden && $func =~ $hidden and @stack = (), last;
# Add stack frame if it's within our threshold
- $inperl <= $opt{frames} and push @stack, $inperl ? $frame : $func;
+ if ($inperl <= $opt{frames}) {
+ push @stack, $inperl ? "$func:$file:$lineno" : $func;
+ }
}
# If there's something on the stack and we've seen perl code,
@@ -161,9 +242,9 @@
# Simply find the topmost frame in the call stack within
# the perl source code
- while ($l[$j++] =~ /^\s+(?:at|by) $hexaddr:\s+(\w+\s+\([^:]+:\d+\))?/o) {
+ while ($l[$j++] =~ /^\s+(?:at|by) $hexaddr:\s+(?:(\w+)\s+\(([^:]+):(\d+)\))?/o)
{
if (defined $1) {
- $error{$line}{$1}{$test}++;
+ $error{$line}{"$1:$2:$3"}{$test}++;
last;
}
}
@@ -184,8 +265,10 @@
=head1 SYNOPSIS
-valgrindpp.pl [B<--dir>=I<dir>] [B<--output-file>=I<file>]
-[B<--frames>=I<number>] [B<--hide>=I<identifier>] [B<--verbose>]
+valgrindpp.pl [B<--dir>=I<dir>] [B<--frames>=I<number>]
+[B<--hide>=I<identifier>] [B<--lines>]
+[B<--output-file>=I<file>] [B<--tests>]
+[B<--top>=I<number>] [B<--verbose>]
=head1 DESCRIPTION
@@ -206,11 +289,6 @@
either the perl source or the I<t> directory and will process
all I<.valgrind> files within the distribution.
-=item B<--output-file>=I<file>
-
-Redirect the output into I<file>. If this option is not
-given, the output goes to I<stdout>.
-
=item B<--frames>=I<number>
Number of stack frames within the perl source code to
@@ -226,6 +304,27 @@
have lots of memory leaks. I<identifier> can also be a regular
expression, in which case all leaks with symbols matching the
expression are hidden. Can be given multiple times.
+
+=item B<--lines>
+
+Show line numbers for stack frames. This is useful for further
+increasing the error/leak resolution, but makes it harder to
+compare different reports using I<diff>.
+
+=item B<--output-file>=I<file>
+
+Redirect the output into I<file>. If this option is not
+given, the output goes to I<stdout>.
+
+=item B<--tests>
+
+List all tests that trigger memory access errors or memory
+leaks explicitly instead of only printing a count.
+
+=item B<--top>=I<number>
+
+List the top I<number> test scripts for memory access errors
+and memory leaks. Set to C<0> for no top-I<n> statistics.
=item B<--verbose>
==== //depot/maint-5.8/perl/README.aix#6 (text) ====
Index: perl/README.aix
--- perl/README.aix#5~20897~ Mon Aug 25 12:56:08 2003
+++ perl/README.aix Mon Sep 1 21:39:23 2003
@@ -209,6 +209,9 @@
which makes Configure to use the C<nm> tool when scanning for library
symbols, which usually is not done in AIX.
+Related to this, you probably should not use the C<-r> option of
+Configure in AIX, because that affects of how the C<nm> tool is used.
+
=head2 Using GNU's gcc for building perl
Using gcc-3.x (tested with 3.0.4, 3.1, and 3.2) now works out of the box,
==== //depot/maint-5.8/perl/lib/Unicode/Collate.pm#6 (text) ====
Index: perl/lib/Unicode/Collate.pm
--- perl/lib/Unicode/Collate.pm#5~20460~ Sun Aug 3 12:09:33 2003
+++ perl/lib/Unicode/Collate.pm Mon Sep 1 21:39:23 2003
@@ -14,7 +14,7 @@
require Exporter;
-our $VERSION = '0.26';
+our $VERSION = '0.27';
our $PACKAGE = __PACKAGE__;
our @ISA = qw(Exporter);
@@ -225,17 +225,18 @@
croak "Unicode/Normalize.pm is required to normalize strings: $@"
if $@;
- Unicode::Normalize->import();
$getCombinClass = \&Unicode::Normalize::getCombinClass
if ! $getCombinClass;
- $self->{normCode} =
- $self->{normalization} =~ /^(?:NF)?C$/ ? \&NFC :
- $self->{normalization} =~ /^(?:NF)?D$/ ? \&NFD :
- $self->{normalization} =~ /^(?:NF)?KC$/ ? \&NFKC :
- $self->{normalization} =~ /^(?:NF)?KD$/ ? \&NFKD :
- croak "$PACKAGE unknown normalization form name: "
- . $self->{normalization};
+ my $norm = $self->{normalization};
+ $self->{normCode} = sub {
+ Unicode::Normalize::normalize($norm, shift);
+ };
+
+ eval { $self->{normCode}->("") }; # try
+ if ($@) {
+ croak "$PACKAGE unknown normalization form name: $norm";
+ }
}
return;
}
@@ -477,10 +478,13 @@
if ($max->{$ce}) { # contract
my $temp_ce = $ce;
+ my $ceLen = 1;
+ my $maxLen = $max->{$ce};
- for (my $p = $i + 1; $p < @src; $p++) {
+ for (my $p = $i + 1; $ceLen < $maxLen && $p < @src; $p++) {
next if ! defined $src[$p];
$temp_ce .= CODE_SEP . $src[$p];
+ $ceLen++;
if ($ent->{$temp_ce}) {
$ce = $temp_ce;
$i = $p;
@@ -524,8 +528,6 @@
my $self = shift;
my $ce = shift;
my $ent = $self->{entries};
- my $cjk = $self->{overrideCJK};
- my $hang = $self->{overrideHangul};
my $der = $self->{derivCode};
return if !defined $ce;
@@ -536,18 +538,50 @@
my $u = $ce;
if (0xAC00 <= $u && $u <= 0xD7A3) { # is Hangul Syllale
- return map $self->altCE($_),
- $hang
- ? map(pack(VCE_TEMPLATE, NON_VAR, @$_), &$hang($u))
- : defined $hang
- ? map({
- $ent->{$_} ? @{ $ent->{$_} } : $der->($_);
- } _decompHangul($u))
- : $der->($u);
+ my $hang = $self->{overrideHangul};
+ my @hangulCE;
+ if ($hang) {
+ @hangulCE = map(pack(VCE_TEMPLATE, NON_VAR, @$_), &$hang($u));
+ }
+ elsif (!defined $hang) {
+ @hangulCE = $der->($u);
+ }
+ else {
+ my $max = $self->{maxlength};
+ my @decH = _decompHangul($u);
+
+ if (@decH == 2) {
+ my $contract = join(CODE_SEP, @decH);
+ @decH = ($contract) if $ent->{$contract};
+ } else { # must be <@decH == 3>
+ if ($max->{$decH[0]}) {
+ my $contract = join(CODE_SEP, @decH);
+ if ($ent->{$contract}) {
+ @decH = ($contract);
+ } else {
+ $contract = join(CODE_SEP, @decH[0,1]);
+ $ent->{$contract} and @decH = ($contract, $decH[2]);
+ }
+ # even if V's ignorable, LT contraction is not supported.
+ # If such a situatution were required, NFD should be used.
+ }
+ if (@decH == 3 && $max->{$decH[1]}) {
+ my $contract = join(CODE_SEP, @decH[1,2]);
+ $ent->{$contract} and @decH = ($decH[0], $contract);
+ }
+ }
+
+ @hangulCE = map({
+ $ent->{$_} ? @{ $ent->{$_} } : $der->($_);
+ } @decH);
+ }
+ return map $self->altCE($_), @hangulCE;
}
elsif (0x3400 <= $u && $u <= 0x4DB5 ||
0x4E00 <= $u && $u <= 0x9FA5 ||
- 0x20000 <= $u && $u <= 0x2A6D6) { # CJK Ideograph
+ 0x20000 <= $u && $u <= 0x2A6D6) # CJK Ideograph
+ {
+ my $cjk = $self->{overrideCJK};
return map $self->altCE($_),
$cjk
? map(pack(VCE_TEMPLATE, NON_VAR, @$_), &$cjk($u))
@@ -1092,14 +1126,12 @@
If specified, strings are normalized before preparation of sort keys
(the normalization is executed after preprocess).
-As a form name, one of the following names must be used.
-
- 'C' or 'NFC' for Normalization Form C
- 'D' or 'NFD' for Normalization Form D
- 'KC' or 'NFKC' for Normalization Form KC
- 'KD' or 'NFKD' for Normalization Form KD
+A form name C<Unicode::Normalize::normalize()> accepts will be applied
+as C<$normalization_form>.
+See C<Unicode::Normalize::normalize()> for detail.
+If omitted, C<'NFD'> is used.
-If omitted, the string is put into Normalization Form D.
+L<normalization> is performed after L<preprocess> (if defined).
If C<undef> is passed explicitly as the value for this key,
any normalization is not carried out (this may make tailoring easier
@@ -1169,9 +1201,11 @@
preprocess => sub {
my $str = shift;
$str =~ s/\b(?:an?|the)\s+//gi;
- $str;
+ return $str;
},
+L<preprocess> is performed before L<normalization> (if defined).
+
=item rearrange
-- see 3.1.3 Rearrangement, UTS #10.
@@ -1505,7 +1539,7 @@
=head1 AUTHOR
-SADAHIRO Tomoyuki, E<lt>[EMAIL PROTECTED]<gt>
+SADAHIRO Tomoyuki, <[EMAIL PROTECTED]>
http://homepage1.nifty.com/nomenclator/perl/
==== //depot/maint-5.8/perl/lib/Unicode/Collate/Changes#6 (text) ====
Index: perl/lib/Unicode/Collate/Changes
--- perl/lib/Unicode/Collate/Changes#5~20460~ Sun Aug 3 12:09:33 2003
+++ perl/lib/Unicode/Collate/Changes Mon Sep 1 21:39:23 2003
@@ -1,8 +1,21 @@
Revision history for Perl module Unicode::Collate.
+0.27 Sun Aug 31 22:23:17 2003
+ some improvements:
+ - The maximum length of contracted CE was not checked.
+ Collation of a large string including a first letter of a contraction
+ that is not a part of that contraction (say, 'c' of 'ca'
+ where 'ch' is defined) was too slow, inefficient.
+ - A form name for 'normalize', no longer restricted to /^(?:NF)?K?[CD]\z/,
+ will be allowed as long as Unicode::Normalize::normalize() accepts it.
+ since Unicode::Normalize or UAX #15 may be changed/enhanced in future.
+ - When Hangul syllables are decomposed under <normalization => undef>,
+ contraction among jamo (LV, VT, LVT) derived from the same
+ Hangul syllable is allowed. Added hangul.t.
+
0.26 Sun Aug 03 22:23:17 2003
- fix: an expansion in which a CE is level 3 ignorable and others are not
- was wrongly made level 3 ignorable as a whole entry.
+ was wrongly made level 3 ignorable as a whole entry.
(In DUCET, some precomposites in Musical Symbols are so)
0.25 Mon Jun 06 23:20:17 2003
==== //depot/maint-5.8/perl/lib/Unicode/Collate/README#6 (text) ====
Index: perl/lib/Unicode/Collate/README
--- perl/lib/Unicode/Collate/README#5~20460~ Sun Aug 3 12:09:33 2003
+++ perl/lib/Unicode/Collate/README Mon Sep 1 21:39:23 2003
@@ -1,4 +1,4 @@
-Unicode/Collate version 0.26
+Unicode/Collate version 0.27
===============================
NAME
==== //depot/maint-5.8/perl/lib/Unicode/Collate/t/hangul.t#1 (text) ====
Index: perl/lib/Unicode/Collate/t/hangul.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/lib/Unicode/Collate/t/hangul.t Mon Sep 1 21:39:23 2003
@@ -0,0 +1,193 @@
+BEGIN {
+ unless ("A" eq pack('U', 0x41)) {
+ print "1..0 # Unicode::Collate " .
+ "cannot stringify a Unicode code point\n";
+ exit 0;
+ }
+}
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir('t') if -d 't';
+ @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
+ }
+}
+
+use Test;
+BEGIN { plan tests => 52 };
+
+use strict;
+use warnings;
+use Unicode::Collate;
+
+use vars qw($IsEBCDIC);
+$IsEBCDIC = ord("A") != 0x41;
+
+#########################
+
+ok(1); # If we made it this far, we're ok.
+
+# a standard collator (3.1.1)
+my $Collator = Unicode::Collate->new(
+ table => 'keys.txt',
+ normalization => undef,
+);
+
+
+# a collator for hangul sorting,
+# cf. http://std.dkuug.dk/JTC1/SC22/WG20/docs/documents.html
+# http://std.dkuug.dk/JTC1/SC22/WG20/docs/n1051-hangulsort.pdf
+my $hangul = Unicode::Collate->new(
+ level => 3,
+ table => undef,
+ normalization => undef,
+ entry => <<'ENTRIES',
+0061 ; [.0A15.0020.0002] # LATIN SMALL LETTER A
+0041 ; [.0A15.0020.0008] # LATIN CAPITAL LETTER A
+#1161 ; [.1800.0020.0002] # <comment> initial jungseong A
+#1163 ; [.1801.0020.0002] # <comment> initial jungseong YA
+1100 ; [.1831.0020.0002] # choseong KIYEOK
+1100 1161 ; [.1831.0020.0002][.1800.0020.0002] # G-A
+1100 1163 ; [.1831.0020.0002][.1801.0020.0002] # G-YA
+1101 ; [.1831.0020.0002][.1831.0020.0002] # choseong SSANGKIYEOK
+1101 1161 ; [.1831.0020.0002][.1831.0020.0002][.1800.0020.0002] # GG-A
+1101 1163 ; [.1831.0020.0002][.1831.0020.0002][.1801.0020.0002] # GG-YA
+1102 ; [.1833.0020.0002] # choseong NIEUN
+1102 1161 ; [.1833.0020.0002][.1800.0020.0002] # N-A
+1102 1163 ; [.1833.0020.0002][.1801.0020.0002] # N-YA
+3042 ; [.1921.0020.000E] # HIRAGANA LETTER A
+11A8 ; [.FE10.0020.0002] # jongseong KIYEOK
+11A9 ; [.FE10.0020.0002][.FE10.0020.0002] # jongseong SSANGKIYEOK
+1161 ; [.FE20.0020.0002] # jungseong A <non-initial>
+1163 ; [.FE21.0020.0002] # jungseong YA <non-initial>
+ENTRIES
+);
+
+ok(ref $hangul, "Unicode::Collate");
+
+#########################
+
+# L(simp)L(simp) vs L(comp): /GGA/
+ok($Collator->lt("\x{1100}\x{1100}\x{1161}", "\x{1101}\x{1161}"));
+ok($hangul ->eq("\x{1100}\x{1100}\x{1161}", "\x{1101}\x{1161}"));
+
+# L(simp) vs L(simp)L(simp): /GA/ vs /GGA/
+ok($Collator->gt("\x{1100}\x{1161}", "\x{1100}\x{1100}\x{1161}"));
+ok($hangul ->lt("\x{1100}\x{1161}", "\x{1100}\x{1100}\x{1161}"));
+
+# T(simp)T(simp) vs T(comp): /AGG/
+ok($Collator->lt("\x{1161}\x{11A8}\x{11A8}", "\x{1161}\x{11A9}"));
+ok($hangul ->eq("\x{1161}\x{11A8}\x{11A8}", "\x{1161}\x{11A9}"));
+
+# T(simp) vs T(simp)T(simp): /AG/ vs /AGG/
+ok($Collator->lt("\x{1161}\x{11A8}", "\x{1161}\x{11A8}\x{11A8}"));
+ok($hangul ->lt("\x{1161}\x{11A8}", "\x{1161}\x{11A8}\x{11A8}"));
+
+# LV vs LLV: /GA/ vs /GNA/
+ok($Collator->gt("\x{1100}\x{1161}", "\x{1100}\x{1102}\x{1161}"));
+ok($hangul ->lt("\x{1100}\x{1161}", "\x{1100}\x{1102}\x{1161}"));
+
+# LVX vs LVV: /GAA/ vs /GA/.latinA
+ok($Collator->gt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}A"));
+ok($hangul ->gt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}A"));
+
+# LVX vs LVV: /GAA/ vs /GA/.hiraganaA
+ok($Collator->lt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}\x{3042}"));
+ok($hangul ->gt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}\x{3042}"));
+
+# LVX vs LVV: /GAA/ vs /GA/.hanja
+ok($Collator->lt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}\x{4E00}"));
+ok($hangul ->gt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}\x{4E00}"));
+
+# LVL vs LVT: /GA/./G/ vs /GAG/
+ok($Collator->lt("\x{1100}\x{1161}\x{1100}", "\x{1100}\x{1161}\x{11A8}"));
+ok($hangul ->lt("\x{1100}\x{1161}\x{1100}", "\x{1100}\x{1161}\x{11A8}"));
+
+# LVT vs LVX: /GAG/ vs /GA/.latinA
+ok($Collator->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}A"));
+ok($hangul ->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}A"));
+
+# LVT vs LVX: /GAG/ vs /GA/.hiraganaA
+ok($Collator->lt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{3042}"));
+ok($hangul ->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{3042}"));
+
+# LVT vs LVX: /GAG/ vs /GA/.hanja
+ok($Collator->lt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{4E00}"));
+ok($hangul ->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{4E00}"));
+
+# LVT vs LVV: /GAG/ vs /GAA/
+ok($Collator->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{1161}"));
+ok($hangul ->lt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{1161}"));
+
+# LVL vs LVV: /GA/./G/ vs /GAA/
+ok($Collator->lt("\x{1100}\x{1161}\x{1100}", "\x{1100}\x{1161}\x{1161}"));
+ok($hangul ->lt("\x{1100}\x{1161}\x{1100}", "\x{1100}\x{1161}\x{1161}"));
+
+# LV vs Syl(LV): /GA/ vs /[GA]/
+ok($Collator->eq("\x{1100}\x{1161}", "\x{AC00}"));
+ok($hangul ->eq("\x{1100}\x{1161}", "\x{AC00}"));
+
+# LVT vs Syl(LV)T: /GAG/ vs /[GA]G/
+ok($Collator->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC00}\x{11A8}"));
+ok($hangul ->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC00}\x{11A8}"));
+
+# LVT vs Syl(LVT): /GAG/ vs /[GAG]/
+ok($Collator->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC01}"));
+ok($hangul ->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC01}"));
+
+# LVTT vs Syl(LVTT): /GAGG/ vs /[GAGG]/
+ok($Collator->eq("\x{1100}\x{1161}\x{11A9}", "\x{AC02}"));
+ok($hangul ->eq("\x{1100}\x{1161}\x{11A9}", "\x{AC02}"));
+
+# LVTT vs Syl(LVT).T: /GAGG/ vs /[GAG]G/
+ok($Collator->gt("\x{1100}\x{1161}\x{11A9}", "\x{AC01}\x{11A8}"));
+ok($hangul ->eq("\x{1100}\x{1161}\x{11A9}", "\x{AC01}\x{11A8}"));
+
+# LLVT vs L.Syl(LVT): /GGAG/ vs /G[GAG]/
+ok($Collator->gt("\x{1101}\x{1161}\x{11A8}", "\x{1100}\x{AC01}"));
+ok($hangul ->eq("\x{1101}\x{1161}\x{11A8}", "\x{1100}\x{AC01}"));
+
+#########################
+
+# checks contraction in LVT:
+# weights of these contractions may be non-sense.
+
+my $hangcont = Unicode::Collate->new(
+ level => 3,
+ table => undef,
+ normalization => undef,
+ entry => <<'ENTRIES',
+1100 ; [.1831.0020.0002] # HANGUL CHOSEONG KIYEOK
+1101 ; [.1832.0020.0002] # HANGUL CHOSEONG SSANGKIYEOK
+1161 ; [.188D.0020.0002] # HANGUL JUNGSEONG A
+1162 ; [.188E.0020.0002] # HANGUL JUNGSEONG AE
+1163 ; [.188F.0020.0002] # HANGUL JUNGSEONG YA
+11A8 ; [.18CF.0020.0002] # HANGUL JONGSEONG KIYEOK
+11A9 ; [.18D0.0020.0002] # HANGUL JONGSEONG SSANGKIYEOK
+1161 11A9 ; [.0000.0000.0000] # A-GG <contraction>
+1100 1163 11A8 ; [.1000.0020.0002] # G-YA-G <contraction> eq. U+AC39
+ENTRIES
+);
+
+# contracted into VT
+ok($Collator->lt("\x{1101}", "\x{1101}\x{1161}\x{11A9}"));
+ok($hangcont->eq("\x{1101}", "\x{1101}\x{1161}\x{11A9}"));
+
+# not contracted into LVT but into VT
+ok($Collator->lt("\x{1100}", "\x{1100}\x{1161}\x{11A9}"));
+ok($hangcont->eq("\x{1100}", "\x{1100}\x{1161}\x{11A9}"));
+
+# contracted into LVT
+ok($Collator->gt("\x{1100}\x{1163}\x{11A8}", "\x{1100}"));
+ok($hangcont->lt("\x{1100}\x{1163}\x{11A8}", "\x{1100}"));
+
+# LVTT vs Syl(LVTT): /GAGG/ vs /[GAGG]/
+ok($Collator->eq("\x{1100}\x{1161}\x{11A9}", "\x{AC02}"));
+ok($hangcont->eq("\x{1100}\x{1161}\x{11A9}", "\x{AC02}"));
+
+# LVT vs Syl(LVT): /GYAG/ vs /[GYAG]/
+ok($Collator->eq("\x{1100}\x{1163}\x{11A8}", "\x{AC39}"));
+ok($hangcont->eq("\x{1100}\x{1163}\x{11A8}", "\x{AC39}"));
+
+1;
+__END__
==== //depot/maint-5.8/perl/op.c#38 (text) ====
Index: perl/op.c
--- perl/op.c#37~20934~ Fri Aug 29 08:12:24 2003
+++ perl/op.c Mon Sep 1 21:39:23 2003
@@ -5412,7 +5412,7 @@
#if !defined(PERL_EXTERNAL_GLOB)
/* XXX this can be tightened up and made more failsafe. */
- if (!gv) {
+ if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {
GV *glob_gv;
ENTER;
Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
==== //depot/maint-5.8/perl/pod/perlfaq4.pod#9 (text) ====
Index: perl/pod/perlfaq4.pod
--- perl/pod/perlfaq4.pod#8~20818~ Thu Aug 21 22:54:24 2003
+++ perl/pod/perlfaq4.pod Mon Sep 1 21:39:23 2003
@@ -2037,8 +2037,9 @@
=head2 How do I print out or copy a recursive data structure?
The Data::Dumper module on CPAN (or the 5.005 release of Perl) is great
-for printing out data structures. The Storable module, found on CPAN,
-provides a function called C<dclone> that recursively copies its argument.
+for printing out data structures. The Storable module on CPAN (or the
+5.8 release of Perl), provides a function called C<dclone> that recursively
+copies its argument.
use Storable qw(dclone);
$r2 = dclone($r1);
==== //depot/maint-5.8/perl/pod/pod2usage.PL#4 (text) ====
Index: perl/pod/pod2usage.PL
--- perl/pod/pod2usage.PL#3~20934~ Fri Aug 29 08:12:24 2003
+++ perl/pod/pod2usage.PL Mon Sep 1 21:39:23 2003
@@ -15,9 +15,8 @@
# This is so that make depend always knows where to find PL derivatives.
$origdir = cwd;
chdir(dirname($0));
-($file = basename($0)) =~ s/\.PL$//;
-$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving"
-$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving"
+$file = basename($0, '.PL');
+$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
==== //depot/maint-5.8/perl/pod/podselect.PL#6 (text) ====
Index: perl/pod/podselect.PL
--- perl/pod/podselect.PL#5~20934~ Fri Aug 29 08:12:24 2003
+++ perl/pod/podselect.PL Mon Sep 1 21:39:23 2003
@@ -15,9 +15,8 @@
# This is so that make depend always knows where to find PL derivatives.
$origdir = cwd;
chdir(dirname($0));
-($file = basename($0)) =~ s/\.PL$//;
-$file =~ s/\.pl$// if ($^O eq 'os2' or $^O eq 'dos'); # "case-forgiving"
-$file =~ s/\.pl$/.com/ if ($^O eq 'VMS'); # "case-forgiving"
+$file = basename($0, '.PL');
+$file .= '.com' if $^O eq 'VMS';
open OUT,">$file" or die "Can't create $file: $!";
==== //depot/maint-5.8/perl/t/op/sprintf.t#8 (xtext) ====
Index: perl/t/op/sprintf.t
--- perl/t/op/sprintf.t#7~19951~ Thu Jul 3 01:47:35 2003
+++ perl/t/op/sprintf.t Mon Sep 1 21:39:23 2003
@@ -43,6 +43,9 @@
$Is_VMS_VAX = $hw_model < 1024 ? 1 : 0;
}
+# No %Config.
+my $Is_Ultrix_VAX = $^O eq 'ultrix' && `uname -m` =~ /^VAX$/;
+
for ($i = 1; @tests; $i++) {
($template, $data, $result, $comment) = @{shift @tests};
if ($^O eq 'os390' || $^O eq 's390') { # non-IEEE (s390 is UTS)
@@ -51,9 +54,10 @@
$data =~ s/([eE])\-101$/${1}-56/; # larger exponents
$result =~ s/([eE])\-102$/${1}-57/; # " "
}
- if ($Is_VMS_VAX) { # VAX DEC C 5.3 at least since there is no
- # ccflags =~ /float=ieee/ on VAX.
- # AXP is unaffected whether or not it's using ieee.
+ if ($Is_VMS_VAX || $Is_Ultrix_VAX) {
+ # VAX DEC C 5.3 at least since there is no
+ # ccflags =~ /float=ieee/ on VAX.
+ # AXP is unaffected whether or not it's using ieee.
$data =~ s/([eE])96$/${1}26/; # smaller exponents
$result =~ s/([eE]\+)102$/${1}32/; # " "
$data =~ s/([eE])\-101$/${1}-24/; # larger exponents
==== //depot/maint-5.8/perl/t/run/fresh_perl.t#7 (text) ====
Index: perl/t/run/fresh_perl.t
--- perl/t/run/fresh_perl.t#6~20906~ Tue Aug 26 02:38:57 2003
+++ perl/t/run/fresh_perl.t Mon Sep 1 21:39:23 2003
@@ -822,5 +822,20 @@
$_="foo";utf8::upgrade($_);/bar/i,warn$_;
EXPECT
foo at - line 1.
-
-
+######## glob() bug Mon, 01 Sep 2003 02:25:41 -0700 <[EMAIL PROTECTED]>
+-lw
+print glob(q(./"TEST"));
+use File::Glob;
+print glob(q(./"TEST"));
+EXPECT
+./"TEST"
+./"TEST"
+######## glob() bug Mon, 01 Sep 2003 02:25:41 -0700 <[EMAIL PROTECTED]>
+-lw
+use File::Glob;
+print glob(q(./"TEST"));
+use File::Glob;
+print glob(q(./"TEST"));
+EXPECT
+./"TEST"
+./"TEST"
==== //depot/maint-5.8/perl/wince/Makefile.ce#11 (text) ====
Index: perl/wince/Makefile.ce
--- perl/wince/Makefile.ce#10~20504~ Tue Aug 5 09:12:30 2003
+++ perl/wince/Makefile.ce Mon Sep 1 21:39:23 2003
@@ -772,9 +772,17 @@
$(COPY) dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
#----------------------------------------------------------------------------------
+NOT_COMPILE_EXT =
+!if "$(MACHINE)" == "wince-sh3-palm-wce211"
+NOT_COMPILE_EXT = $(NOT_COMPILE_EXT) !XS/Typemap
+!endif
+!if "$(MACHINE)" == "wince-mips-palm-wce211"
+NOT_COMPILE_EXT = $(NOT_COMPILE_EXT) !XS/Typemap
+!endif
+
Extensions: ..\win32\buildext.pl $(PERLDEP) $(CONFIGPM)
$(HPERL) -I..\lib -I..\win32 -MCross=$(CROSS_NAME) ..\win32\buildext.pl
$(MAKE) $(PERLDEP) $(EXTDIR) \
- !POSIX
+ !POSIX $(NOT_COMPILE_EXT)
Extensions_clean:
-if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP)
$(EXTDIR) clean
==== //depot/maint-5.8/perl/wince/wince.c#8 (text) ====
Index: perl/wince/wince.c
--- perl/wince/wince.c#7~20504~ Tue Aug 5 09:12:30 2003
+++ perl/wince/wince.c Mon Sep 1 21:39:23 2003
@@ -41,6 +41,8 @@
#include "cewin32_defs.h"
#include "cecrt_defs.h"
+#define GetCurrentDirectoryW XCEGetCurrentDirectoryW
+
#ifdef PALM_SIZE
#include "stdio-palmsize.h"
#endif
@@ -1253,52 +1255,6 @@
#endif
}
-/* C doesn't like repeat struct definitions */
-
-#if defined(USE_FIXED_OSFHANDLE) || defined(PERL_MSVCRT_READFIX)
-
-#ifndef _CRTIMP
-#define _CRTIMP __declspec(dllimport)
-#endif
-
-/*
- * Control structure for lowio file handles
- */
-typedef struct {
- long osfhnd; /* underlying OS file HANDLE */
- char osfile; /* attributes of file (e.g., open in text mode?) */
- char pipech; /* one char buffer for handles opened on pipes */
- int lockinitflag;
- CRITICAL_SECTION lock;
-} ioinfo;
-
-
-/*
- * Array of arrays of control structures for lowio files.
- */
-EXTERN_C _CRTIMP ioinfo* __pioinfo[];
-
-/*
- * Definition of IOINFO_L2E, the log base 2 of the number of elements in each
- * array of ioinfo structs.
- */
-#define IOINFO_L2E 5
-
-/*
- * Definition of IOINFO_ARRAY_ELTS, the number of elements in ioinfo array
- */
-#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E)
-
-/*
- * Access macros for getting at an ioinfo struct and its fields from a
- * file handle
- */
-#define _pioinfo(i) (__pioinfo[(i) >> IOINFO_L2E] + ((i) & (IOINFO_ARRAY_ELTS - 1)))
-#define _osfhnd(i) (_pioinfo(i)->osfhnd)
-#define _osfile(i) (_pioinfo(i)->osfile)
-#define _pipech(i) (_pioinfo(i)->pipech)
-
-#endif
/*
* redirected io subsystem for all XS modules
End of Patch.
