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.