Change 18567 by jhi@kosh on 2003/01/22 18:37:55
Integrate:
[ 18545]
Subject: [PATCH perl-current] AUTHORS correction
From: Richard Soderberg <[EMAIL PROTECTED]>
Date: Wed, 22 Jan 2003 02:08:13 -0500
Message-Id: <[EMAIL PROTECTED]>
[ 18552]
Subject: [PATCH] assert PV isn't RV
From: Nicholas Clark <[EMAIL PROTECTED]>
Date: Fri, 17 Jan 2003 19:40:45 +0000
Message-ID: <[EMAIL PROTECTED]>
[ 18553]
Subject: Term::Complete problem + fix (Was: Re: muttprofile + perl 5.8)
From: Martti Rahkila <[EMAIL PROTECTED]>
Date: Sat, 18 Jan 2003 00:25:39 +0200
Message-ID: <[EMAIL PROTECTED]>
(chose the 'even safer' version)
[ 18554]
Subject: [PATCH av.c] Re: [perl #15439] unreferenced scalar due to double
DESTROY
From: Dave Mitchell <[EMAIL PROTECTED]>
Date: Sun, 19 Jan 2003 16:43:54 +0000
Message-ID: <[EMAIL PROTECTED]>
[ 18556]
Subject: [PATCH perlio.h] (was RE: [PATCH] %_ (was Re: [PATCH] operation on
`PL_na' may be undefined))
From: Robin Barker <[EMAIL PROTECTED]>
Date: Mon, 20 Jan 2003 15:26:21 -0000
Message-ID: <[EMAIL PROTECTED]>
[ 18559]
Upgrade to Encode 1.86.
Affected files ...
... //depot/maint-5.8/perl/AUTHORS#3 integrate
... //depot/maint-5.8/perl/av.c#7 integrate
... //depot/maint-5.8/perl/dump.c#8 integrate
... //depot/maint-5.8/perl/ext/Encode/Changes#5 integrate
... //depot/maint-5.8/perl/ext/Encode/Encode.pm#5 integrate
... //depot/maint-5.8/perl/ext/Encode/MANIFEST#5 integrate
... //depot/maint-5.8/perl/ext/Encode/Unicode/Unicode.xs#3 integrate
... //depot/maint-5.8/perl/ext/Encode/encoding.pm#4 integrate
... //depot/maint-5.8/perl/ext/Encode/t/enc_eucjp.t#2 integrate
... //depot/maint-5.8/perl/ext/Encode/t/enc_utf8.t#2 integrate
... //depot/maint-5.8/perl/lib/Term/Complete.pm#3 integrate
... //depot/maint-5.8/perl/perlio.h#2 integrate
... //depot/maint-5.8/perl/sv.h#8 integrate
... //depot/maint-5.8/perl/t/op/array.t#2 integrate
Differences ...
==== //depot/maint-5.8/perl/AUTHORS#3 (text) ====
Index: perl/AUTHORS
--- perl/AUTHORS#2~18080~ Sun Nov 3 21:23:04 2002
+++ perl/AUTHORS Wed Jan 22 10:37:55 2003
@@ -131,7 +131,6 @@
Colin Watson <[EMAIL PROTECTED]>
Conrad Augustin
Conrad E. Kimball <[EMAIL PROTECTED]>
-Coral <[EMAIL PROTECTED]>
Craig A. Berry <[EMAIL PROTECTED]>
Craig Milo Rogers <[EMAIL PROTECTED]>
Curtis Poe <[EMAIL PROTECTED]>
==== //depot/maint-5.8/perl/av.c#7 (text) ====
Index: perl/av.c
--- perl/av.c#6~18208~ Thu Nov 28 08:57:01 2002
+++ perl/av.c Wed Jan 22 10:37:55 2003
@@ -453,8 +453,11 @@
ary = AvARRAY(av);
key = AvFILLp(av) + 1;
while (key) {
- SvREFCNT_dec(ary[--key]);
+ SV * sv = ary[--key];
+ /* undef the slot before freeing the value, because a
+ * destructor might try to modify this arrray */
ary[key] = &PL_sv_undef;
+ SvREFCNT_dec(sv);
}
}
if ((key = AvARRAY(av) - AvALLOC(av))) {
==== //depot/maint-5.8/perl/dump.c#8 (text) ====
Index: perl/dump.c
--- perl/dump.c#7~18387~ Wed Jan 1 17:39:31 2003
+++ perl/dump.c Wed Jan 22 10:37:55 2003
@@ -194,10 +194,22 @@
sv_catpv(t, "(");
unref++;
}
- else if (DEBUG_R_TEST_ && SvREFCNT(sv) > 1) {
- Perl_sv_catpvf(aTHX_ t, "<%"UVuf">", (UV)SvREFCNT(sv));
+ else if (DEBUG_R_TEST_) {
+ int is_tmp = 0;
+ I32 ix;
+ /* is this SV on the tmps stack? */
+ for (ix=PL_tmps_ix; ix>=0; ix--) {
+ if (PL_tmps_stack[ix] == sv) {
+ is_tmp = 1;
+ break;
+ }
+ }
+ if (SvREFCNT(sv) > 1)
+ Perl_sv_catpvf(aTHX_ t, "<%"UVuf"%s>", (UV)SvREFCNT(sv),
+ is_tmp ? "T" : "");
+ else if (is_tmp)
+ sv_catpv(t, "<T>");
}
-
if (SvROK(sv)) {
sv_catpv(t, "\\");
==== //depot/maint-5.8/perl/ext/Encode/Changes#5 (text) ====
Index: perl/ext/Encode/Changes
--- perl/ext/Encode/Changes#4~18503~ Thu Jan 16 15:29:57 2003
+++ perl/ext/Encode/Changes Wed Jan 22 10:37:55 2003
@@ -1,9 +1,25 @@
# Revision history for Perl extension Encode.
#
-# $Id: Changes,v 1.84 2003/01/10 12:00:16 dankogai Exp dankogai $
+# $Id: Changes,v 1.86 2003/01/22 03:29:07 dankogai Exp $
#
-$Revision: 1.84 $ $Date: 2003/01/10 12:00:16 $
+$Revision: 1.86 $ $Date: 2003/01/22 03:29:07 $
+! encoding.pm
+ * Don't forget to canonize when you attempt an exact match!
+ Message-Id: <[EMAIL PROTECTED]>
+ * ${^ENCODING} exception is off for $] > 5.008
+ Message-Id: <[EMAIL PROTECTED]>
+! t/enc_utf8.t
+ $] check commented out so it runs on 5.8.0
+
+1.85 2003/01/21 22:19:14
+! encoding.pm
+ ${^ENCODING} exception is now explicit rather than handled by regex.
++ t/enc_eucjp.t t/enc_utf8.t
+ Test suite for the better "encoding" pragma support for bleedperl.
+ On 5.8.0, they will just be skipped.
+
+1.84 2003/01/10 12:00:16
! encoding.pm
${^ENCODING} is no longer set for utf so encoding is no longer fun :)
(That is to prevent duplicate encoding first by IO then ${^ENCODING})
==== //depot/maint-5.8/perl/ext/Encode/Encode.pm#5 (text) ====
Index: perl/ext/Encode/Encode.pm
--- perl/ext/Encode/Encode.pm#4~18503~ Thu Jan 16 15:29:57 2003
+++ perl/ext/Encode/Encode.pm Wed Jan 22 10:37:55 2003
@@ -1,9 +1,9 @@
#
-# $Id: Encode.pm,v 1.84 2003/01/10 12:00:16 dankogai Exp dankogai $
+# $Id: Encode.pm,v 1.86 2003/01/22 03:30:40 dankogai Exp $
#
package Encode;
use strict;
-our $VERSION = do { my @r = (q$Revision: 1.84 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
+our $VERSION = do { my @r = (q$Revision: 1.86 $ =~ /\d+/g); sprintf "%d."."%02d" x
+$#r, @r };
our $DEBUG = 0;
use XSLoader ();
XSLoader::load(__PACKAGE__, $VERSION);
==== //depot/maint-5.8/perl/ext/Encode/Unicode/Unicode.xs#3 (text) ====
Index: perl/ext/Encode/Unicode/Unicode.xs
--- perl/ext/Encode/Unicode/Unicode.xs#2~18503~ Thu Jan 16 15:29:57 2003
+++ perl/ext/Encode/Unicode/Unicode.xs Wed Jan 22 10:37:55 2003
@@ -1,5 +1,5 @@
/*
- $Id: Unicode.xs,v 1.6 2003/01/10 12:00:16 dankogai Exp dankogai $
+ $Id: Unicode.xs,v 1.6 2003/01/10 12:00:16 dankogai Exp $
*/
#define PERL_NO_GET_CONTEXT
==== //depot/maint-5.8/perl/ext/Encode/encoding.pm#4 (text) ====
Index: perl/ext/Encode/encoding.pm
--- perl/ext/Encode/encoding.pm#3~18503~ Thu Jan 16 15:29:57 2003
+++ perl/ext/Encode/encoding.pm Wed Jan 22 10:37:55 2003
@@ -1,5 +1,5 @@
package encoding;
-our $VERSION = do { my @r = (q$Revision: 1.38 $ =~ /\d+/g); sprintf "%d."."%02d" x
$#r, @r };
+our $VERSION = do { my @r = (q$Revision: 1.40 $ =~ /\d+/g); sprintf "%d."."%02d" x
+$#r, @r };
use Encode;
use strict;
@@ -17,6 +17,9 @@
$HAS_PERLIO = (PerlIO::encoding->VERSION >= 0.02);
}
+my %utfs = map {$_=>1}
+ qw(utf8 UCS-2BE UCS-2LE UTF-16 UTF-16BE UTF-16LE UTF-32 UTF-32BE UTF-32LE);
+
sub import {
my $class = shift;
my $name = shift;
@@ -28,8 +31,9 @@
require Carp;
Carp::croak("Unknown encoding '$name'");
}
+ $name = $enc->name; # canonize
unless ($arg{Filter}) {
- ${^ENCODING} = $enc;
+ ${^ENCODING} = $enc unless $] <= 5.008 and $utfs{$name};
$HAS_PERLIO or return 1;
for my $h (qw(STDIN STDOUT)){
if ($arg{$h}){
==== //depot/maint-5.8/perl/ext/Encode/t/enc_eucjp.t#2 (text) ====
Index: perl/ext/Encode/t/enc_eucjp.t
--- perl/ext/Encode/t/enc_eucjp.t#1~18503~ Thu Jan 16 15:29:57 2003
+++ perl/ext/Encode/t/enc_eucjp.t Wed Jan 22 10:37:55 2003
@@ -1,7 +1,12 @@
+# $Id: enc_eucjp.t,v 1.1 2003/01/21 22:19:14 dankogai Exp $
# This is the twin of enc_utf8.t, the only difference is that
# this has "use encoding 'euc-jp'".
BEGIN {
+ if ($] <= 5.008){
+ print "1..0 # Skip: Perl 5.8.1 or later required\n";
+ exit 0;
+ }
require Config; import Config;
if ($Config{'extensions'} !~ /\bEncode\b/) {
print "1..0 # Skip: Encode was not built\n";
@@ -30,6 +35,7 @@
open(F, ">f$i") or die "$0: failed to open 'f$i' for writing: $!";
binmode(F, ":utf8");
print F chr($c[$i]);
+ print F pack("C" => $c[$i]);
close F;
}
==== //depot/maint-5.8/perl/ext/Encode/t/enc_utf8.t#2 (text) ====
Index: perl/ext/Encode/t/enc_utf8.t
--- perl/ext/Encode/t/enc_utf8.t#1~18503~ Thu Jan 16 15:29:57 2003
+++ perl/ext/Encode/t/enc_utf8.t Wed Jan 22 10:37:55 2003
@@ -1,7 +1,12 @@
+# $Id: enc_utf8.t,v 1.2 2003/01/22 03:29:07 dankogai Exp $
# This is the twin of enc_eucjp.t, the only difference is that
# this has "use encoding 'utf8'".
BEGIN {
+# if ($] <= 5.008){
+# print "1..0 # Skip: Perl 5.8.1 or later required\n";
+# exit 0;
+# }
require Config; import Config;
if ($Config{'extensions'} !~ /\bEncode\b/) {
print "1..0 # Skip: Encode was not built\n";
@@ -40,7 +45,7 @@
binmode(F, ":utf8");
my $c = <F>;
my $o = ord($c);
- print $o == $c[$i] ? "ok $t - utf8 I/O $c[$i]\n" : "not ok $t - utf8 I/O $c[$$i]:
$o != $c[$i]\n";
+ print $o == $c[$i] ? "ok $t - utf8 I/O $c[$i]\n" : "not ok $t - utf8 I/O $c[$i]: $o
+!= $c[$i]\n";
$t++;
}
==== //depot/maint-5.8/perl/lib/Term/Complete.pm#3 (text) ====
Index: perl/lib/Term/Complete.pm
--- perl/lib/Term/Complete.pm#2~18347~ Sun Dec 22 22:37:31 2002
+++ perl/lib/Term/Complete.pm Wed Jan 22 10:37:55 2003
@@ -5,7 +5,7 @@
use strict;
our @ISA = qw(Exporter);
our @EXPORT = qw(Complete);
-our $VERSION = '1.4';
+our $VERSION = '1.401';
# @(#)complete.pl,v1.2 ([EMAIL PROTECTED]) 09/23/91
@@ -66,7 +66,7 @@
=cut
-our($complete, $kill, $erase1, $erase2, $tty_raw_noecho, $tty_restore, $stty);
+our($complete, $kill, $erase1, $erase2, $tty_raw_noecho, $tty_restore, $stty,
+$tty_safe_restore);
our($tty_saved_state) = '';
CONFIG: {
$complete = "\004";
@@ -77,6 +77,7 @@
if (-x $s) {
$tty_raw_noecho = "$s raw -echo";
$tty_restore = "$s -raw echo";
+ $tty_safe_restore = $tty_restore;
$stty = $s;
last;
}
@@ -106,8 +107,8 @@
$tty_saved_state = undef;
}
else {
- chomp $tty_saved_state;
- $tty_restore = qq($stty "$tty_saved_state");
+ $tty_saved_state =~ s/\s+$//g;
+ $tty_restore = qq($stty "$tty_saved_state" 2>/dev/null);
}
}
system $tty_raw_noecho if defined $tty_raw_noecho;
@@ -169,10 +170,18 @@
}
}
}
- system $tty_restore if defined $tty_restore;
+
+ # system $tty_restore if defined $tty_restore;
+ if (defined $tty_saved_state && defined $tty_restore && defined $tty_safe_restore)
+ {
+ system $tty_restore;
+ if ($?) {
+ # tty_restore caused error
+ system $tty_safe_restore;
+ }
+ }
print("\n");
$return;
}
1;
-
==== //depot/maint-5.8/perl/perlio.h#2 (text) ====
Index: perl/perlio.h
--- perl/perlio.h#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/perlio.h Wed Jan 22 10:37:55 2003
@@ -206,7 +206,10 @@
#endif
#ifndef PerlIO_stdoutf
extern int PerlIO_stdoutf(const char *, ...)
- __attribute__ ((__format__(__printf__, 1, 2)));
+#ifdef CHECK_FORMAT
+ __attribute__ ((__format__(__printf__, 1, 2)))
+#endif
+;
#endif
#ifndef PerlIO_puts
extern int PerlIO_puts(PerlIO *, const char *);
@@ -266,11 +269,17 @@
#endif
#ifndef PerlIO_printf
extern int PerlIO_printf(PerlIO *, const char *, ...)
- __attribute__ ((__format__(__printf__, 2, 3)));
+#ifdef CHECK_FORMAT
+ __attribute__ ((__format__(__printf__, 2, 3)))
+#endif
+;
#endif
#ifndef PerlIO_sprintf
extern int PerlIO_sprintf(char *, int, const char *, ...)
- __attribute__ ((__format__(__printf__, 3, 4)));
+#ifdef CHECK_FORMAT
+ __attribute__ ((__format__(__printf__, 3, 4)))
+#endif
+;
#endif
#ifndef PerlIO_vprintf
extern int PerlIO_vprintf(PerlIO *, const char *, va_list);
==== //depot/maint-5.8/perl/sv.h#8 (text) ====
Index: perl/sv.h
--- perl/sv.h#7~18503~ Thu Jan 16 15:29:57 2003
+++ perl/sv.h Wed Jan 22 10:37:55 2003
@@ -546,11 +546,19 @@
#define SvNIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK| \
SVp_IOK|SVp_NOK|SVf_IVisUV))
+#ifdef __GNUC__
+#define assert_not_ROK(sv) ({assert(!SvROK(sv) || !SvRV(sv))})
+#else
+#define assert_not_ROK(sv) 0
+#endif
+
#define SvOK(sv) (SvFLAGS(sv) & SVf_OK)
-#define SvOK_off(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \
+#define SvOK_off(sv) (assert_not_ROK(sv), \
+ SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \
SVf_IVisUV|SVf_UTF8), \
SvOOK_off(sv))
-#define SvOK_off_exc_UV(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \
+#define SvOK_off_exc_UV(sv) (assert_not_ROK(sv), \
+ SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \
SVf_UTF8), \
SvOOK_off(sv))
@@ -560,7 +568,8 @@
#define SvNOKp(sv) (SvFLAGS(sv) & SVp_NOK)
#define SvNOKp_on(sv) (SvFLAGS(sv) |= SVp_NOK)
#define SvPOKp(sv) (SvFLAGS(sv) & SVp_POK)
-#define SvPOKp_on(sv) (SvFLAGS(sv) |= SVp_POK)
+#define SvPOKp_on(sv) (assert_not_ROK(sv), \
+ SvFLAGS(sv) |= SVp_POK)
#define SvIOK(sv) (SvFLAGS(sv) & SVf_IOK)
#define SvIOK_on(sv) ((void)SvOOK_off(sv), \
@@ -611,12 +620,15 @@
#define SvUTF8_off(sv) (SvFLAGS(sv) &= ~(SVf_UTF8))
#define SvPOK(sv) (SvFLAGS(sv) & SVf_POK)
-#define SvPOK_on(sv) (SvFLAGS(sv) |= (SVf_POK|SVp_POK))
+#define SvPOK_on(sv) (assert_not_ROK(sv), \
+ SvFLAGS(sv) |= (SVf_POK|SVp_POK))
#define SvPOK_off(sv) (SvFLAGS(sv) &= ~(SVf_POK|SVp_POK))
-#define SvPOK_only(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \
+#define SvPOK_only(sv) (assert_not_ROK(sv), \
+ SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \
SVf_IVisUV|SVf_UTF8), \
SvFLAGS(sv) |= (SVf_POK|SVp_POK))
-#define SvPOK_only_UTF8(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \
+#define SvPOK_only_UTF8(sv) (assert_not_ROK(sv), \
+ SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \
SVf_IVisUV), \
SvFLAGS(sv) |= (SVf_POK|SVp_POK))
==== //depot/maint-5.8/perl/t/op/array.t#2 (xtext) ====
Index: perl/t/op/array.t
--- perl/t/op/array.t#1~17645~ Fri Jul 19 12:29:57 2002
+++ perl/t/op/array.t Wed Jan 22 10:37:55 2003
@@ -1,6 +1,12 @@
#!./perl
-print "1..72\n";
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+print "1..73\n";
#
# @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
@@ -247,3 +253,22 @@
@tary = (0..50);
tary();
+
+
+require './test.pl';
+
+# bugid #15439 - clearing an array calls destructors which may try
+# to modify the array - caused 'Attempt to free unreferenced scalar'
+
+my $got = runperl (
+ prog => q{
+ sub X::DESTROY { @a = () }
+ @a = (bless {}, 'X');
+ @a = ();
+ },
+ stderr => 1
+ );
+
+$got =~ s/\n/ /g;
+print "# $got\nnot " unless $got eq '';
+print "ok 73\n";
End of Patch.
