Change 19968 by [EMAIL PROTECTED] on 2003/07/03 19:17:29
Integrate:
[ 19957]
Subject: Re: randomly untainting?
From: Rafael Garcia-Suarez <[EMAIL PROTECTED]>
Date: Thu, 3 Jul 2003 14:58:18 +0200
Message-Id: <[EMAIL PROTECTED]>
(plus extra debug printing)
[ 19958]
Regen Configure, Glossary, et alia.
[ 19959]
Regen perltoc.
[ 19960]
perldelta tweaks.
[ 19961]
Extra light testing for the UTF-8 cache
(that it isn't broken, not that it helps).
[ 19962]
Add at least meager beginnings of assertion checks for
the UTF-8 length/pos cache. It's not as full as I would
like since the exact behaviour of the second half of the
cache, used in substr(), eludes me right now.
[ 19963]
Revert #19957 as requested by Rafael.
[ 19964]
Subject: Re: randomly untainting?
From: Rafael Garcia-Suarez <[EMAIL PROTECTED]>
Date: Thu, 3 Jul 2003 17:35:09 +0200
Message-Id: <[EMAIL PROTECTED]>
[ 19965]
Subject: [PATCH] Win32: fix WM_TIMER handling
From: Mattia Barbon <[EMAIL PROTECTED]>
Date: Thu, 3 Jul 2003 16:05:23 +0200 (ora legale Europa occidentale)
Message-ID: <[EMAIL PROTECTED]>
[ 19966]
Subject: Re: [PATCH] Bring Time::Local to 1.07
From: Dave Rolsky <[EMAIL PROTECTED]>
Date: Thu, 3 Jul 2003 14:35:56 -0500 (CDT)
Message-ID: <[EMAIL PROTECTED]>
[ 19967]
Add autarch and Time::Local to Modules.
Affected files ...
... //depot/maint-5.8/perl/Porting/Modules#3 integrate
... //depot/maint-5.8/perl/ext/List/Util/t/tainted.t#2 integrate
... //depot/maint-5.8/perl/lib/Time/Local.pm#4 integrate
... //depot/maint-5.8/perl/sv.c#57 integrate
... //depot/maint-5.8/perl/t/TestInit.pm#3 integrate
... //depot/maint-5.8/perl/t/op/length.t#2 integrate
... //depot/maint-5.8/perl/win32/win32.c#11 integrate
Differences ...
==== //depot/maint-5.8/perl/Porting/Modules#3 (text) ====
Index: perl/Porting/Modules
--- perl/Porting/Modules#2~19951~ Thu Jul 3 01:47:35 2003
+++ perl/Porting/Modules Thu Jul 3 12:17:29 2003
@@ -12,6 +12,7 @@
{
'ams' => 'Abhijit Menon-Sen <[EMAIL PROTECTED]>',
'andreas' => 'Andreas J. Koenig <[EMAIL PROTECTED]>',
+ 'autarch' => 'Dave Rolsky <[EMAIL PROTECTED]>',
'arthur' => 'Arthur Bergman <[EMAIL PROTECTED]>',
'bbb' => 'Rob Brown <[EMAIL PROTECTED]>',
'damian' => 'Damian Conway <[EMAIL PROTECTED]>',
@@ -309,6 +310,12 @@
{
'MAINTAINER' => 'jhi',
'FILES' => q[ext/Time/HiRes],
+ },
+
+ 'Time::Local' =>
+ {
+ 'MAINTAINER' => 'autarch',
+ 'FILES' => q[lib/Time/Local.{pm,t}],
},
'Unicode::Collate' =>
==== //depot/maint-5.8/perl/lib/Time/Local.pm#4 (text) ====
Index: perl/lib/Time/Local.pm
--- perl/lib/Time/Local.pm#3~19704~ Fri Jun 6 22:24:27 2003
+++ perl/lib/Time/Local.pm Thu Jul 3 12:17:29 2003
@@ -7,7 +7,7 @@
use integer;
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK );
-$VERSION = '1.06';
+$VERSION = '1.07';
@ISA = qw( Exporter );
@EXPORT = qw( timegm timelocal );
@EXPORT_OK = qw( timegm_nocheck timelocal_nocheck );
==== //depot/maint-5.8/perl/sv.c#57 (text) ====
Index: perl/sv.c
--- perl/sv.c#56~19951~ Thu Jul 3 01:47:35 2003
+++ perl/sv.c Thu Jul 3 12:17:29 2003
@@ -24,6 +24,24 @@
#define FCALL *f
+#ifdef PERL_UTF8_CACHE_ASSERT
+/* The cache element 0 is the Unicode offset;
+ * the cache element 1 is the byte offset of the element 0;
+ * the cache element 2 is the Unicode length of the substring;
+ * the cache element 3 is the byte length of the substring;
+ * The checking of the substring side would be good
+ * but substr() has enough code paths to make my head spin;
+ * if adding more checks watch out for the following tests:
+ * t/op/index.t t/op/length.t t/op/pat.t t/op/substr.t
+ * lib/utf8.t lib/Unicode/Collate/t/index.t
+ * --jhi
+ */
+#define ASSERT_UTF8_CACHE(cache) \
+ STMT_START { if (cache) { assert((cache)[0] <= (cache)[1]); } } STMT_END
+#else
+#define ASSERT_UTF8_CACHE(cache) NOOP
+#endif
+
/* ============================================================================
=head1 Allocation and deallocation of SVs.
@@ -5372,8 +5390,12 @@
U8 *s = (U8*)SvPV(sv, len);
MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : 0;
- if (mg && mg->mg_len != -1 && (mg->mg_len > 0 || len == 0))
+ if (mg && mg->mg_len != -1 && (mg->mg_len > 0 || len == 0)) {
ulen = mg->mg_len;
+#ifdef PERL_UTF8_CACHE_ASSERT
+ assert(ulen == Perl_utf8_length(aTHX_ s, s + len));
+#endif
+ }
else {
ulen = Perl_utf8_length(aTHX_ s, s + len);
if (!mg && !SvREADONLY(sv)) {
@@ -5443,6 +5465,7 @@
*mgp = mg_find(sv, PERL_MAGIC_utf8);
if (*mgp && (*mgp)->mg_ptr) {
*cachep = (STRLEN *) (*mgp)->mg_ptr;
+ ASSERT_UTF8_CACHE(*cachep);
if ((*cachep)[i] == (STRLEN)uoff) /* An exact match. */
found = TRUE;
else { /* We will skip to the right spot. */
@@ -5515,7 +5538,23 @@
*offsetp = 0;
}
}
- }
+ }
+#ifdef PERL_UTF8_CACHE_ASSERT
+ if (found) {
+ U8 *s = start;
+ I32 n = uoff;
+
+ while (n-- && s < send)
+ s += UTF8SKIP(s);
+
+ if (i == 0) {
+ assert(*offsetp == s - start);
+ assert((*cachep)[0] == (STRLEN)uoff);
+ assert((*cachep)[1] == *offsetp);
+ }
+ ASSERT_UTF8_CACHE(*cachep);
+ }
+#endif
}
return found;
@@ -5589,12 +5628,14 @@
}
*lenp = s - start;
}
+ ASSERT_UTF8_CACHE(cache);
}
else {
*offsetp = 0;
if (lenp)
*lenp = 0;
}
+
return;
}
@@ -5680,6 +5721,7 @@
}
}
}
+ ASSERT_UTF8_CACHE(cache);
}
while (s < send) {
==== //depot/maint-5.8/perl/t/TestInit.pm#3 (text) ====
Index: perl/t/TestInit.pm
--- perl/t/TestInit.pm#2~18080~ Sun Nov 3 21:23:04 2002
+++ perl/t/TestInit.pm Thu Jul 3 12:17:29 2003
@@ -17,7 +17,10 @@
chdir 't' if -d 't';
@INC = '../lib';
-$ENV{PERL_CORE} = 1;
+
+# Don't interfere with the taintedness of %ENV, this could perturbate tests
+$ENV{PERL_CORE} = 1 unless ${^TAINT};
+
$0 =~ s/\.dp$//; # for the test.deparse make target
1;
==== //depot/maint-5.8/perl/t/op/length.t#2 (text) ====
Index: perl/t/op/length.t
--- perl/t/op/length.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/t/op/length.t Thu Jul 3 12:17:29 2003
@@ -5,7 +5,7 @@
@INC = '../lib';
}
-print "1..15\n";
+print "1..20\n";
print "not " unless length("") == 0;
print "ok 1\n";
@@ -132,4 +132,19 @@
print "not " unless length($a) == 3;
print "ok 15\n";
$test++;
+}
+
+{
+ # Play around with Unicode strings,
+ # give a little workout to the UTF-8 length cache.
+ my $a = chr(256) x 100;
+ print length $a == 100 ? "ok 16\n" : "not ok 16\n";
+ chop $a;
+ print length $a == 99 ? "ok 17\n" : "not ok 17\n";
+ $a .= $a;
+ print length $a == 198 ? "ok 18\n" : "not ok 18\n";
+ $a = chr(256) x 999;
+ print length $a == 999 ? "ok 19\n" : "not ok 19\n";
+ substr($a, 0, 1) = '';
+ print length $a == 998 ? "ok 20\n" : "not ok 20\n";
}
==== //depot/maint-5.8/perl/win32/win32.c#11 (text) ====
Index: perl/win32/win32.c
--- perl/win32/win32.c#10~19682~ Tue Jun 3 22:22:46 2003
+++ perl/win32/win32.c Thu Jul 3 12:17:29 2003
@@ -1884,10 +1884,12 @@
case WM_TIMER: {
/* alarm() is a one-shot but SetTimer() repeats so kill it */
- if (w32_timerid) {
+ if (w32_timerid && w32_timerid==msg.wParam) {
KillTimer(NULL,w32_timerid);
w32_timerid=0;
}
+ else
+ goto FallThrough;
/* Now fake a call to signal handler */
if (do_raise(aTHX_ 14)) {
sig_terminate(aTHX_ 14);
@@ -1897,6 +1899,7 @@
/* Otherwise do normal Win32 thing - in case it is useful */
default:
+ FallThrough:
TranslateMessage(&msg);
DispatchMessage(&msg);
ours = 0;
End of Patch.
