From: Nick Ing-Simmons Date: Thu, 17 Jan 2002 21:38:38 +0000 (+0000) Subject: Integrate mainline (for ndbm fixes etc.) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=235bddc8d16c512a7d89f327f65cee68b1f5848c;hp=fc87b71cde2dcc7c5c2201d512e38000eb8087ab;p=p5sagit%2Fp5-mst-13.2.git Integrate mainline (for ndbm fixes etc.) p4raw-id: //depot/perlio@14312 --- diff --git a/Changes b/Changes index aadb5d9..d7f6b7f 100644 --- a/Changes +++ b/Changes @@ -31,6 +31,192 @@ or any other branch. Version v5.7.2 Development release working toward v5.8 -------------- ____________________________________________________________________________ +[ 14309] By: jhi on 2002/01/17 14:39:20 + Log: Rename kill_perl to fresh_perl; replace fresh_perl() + with fresh_perl_is() and fresh_perl_like(). + Branch: perl + + t/run/fresh_perl.t + - t/run/kill_perl.t + ! MANIFEST t/test.pl +____________________________________________________________________________ +[ 14308] By: jhi on 2002/01/17 14:06:46 + Log: Subject: Re: [Patch @14129] fixes Unicode::Normalize + From: Benjamin Goldberg + Date: Wed, 09 Jan 2002 21:03:16 -0500 + Message-ID: <3C3CF664.A2BF3AC2@earthlink.net> + Branch: perl + ! ext/Unicode/Normalize/Normalize.pm +____________________________________________________________________________ +[ 14307] By: jhi on 2002/01/17 14:04:06 + Log: Retract #14144 as Hugo isn't happy with it. + Branch: perl + ! scope.c t/run/kill_perl.t +____________________________________________________________________________ +[ 14306] By: jhi on 2002/01/17 13:57:53 + Log: Subject: [REPATCH] Attribute::Handlers lexical refcount circus + From: Richard Clamp + Date: Wed, 16 Jan 2002 17:34:31 +0000 + Message-ID: <20020116173431.GA28924@mirth.demon.co.uk> + Branch: perl + ! lib/Attribute/Handlers.pm lib/Attribute/Handlers/t/multi.t +____________________________________________________________________________ +[ 14305] By: jhi on 2002/01/17 13:32:56 + Log: Subject: [PATCH bleadperl] No more warnings from Opcode.c + From: Nikola Knezevic + Date: Tue, 15 Jan 2002 21:23:30 +0100 + Message-ID: <595405346.20020115212330@tesla.rcub.bg.ac.yu> + Branch: perl + ! ext/Opcode/Opcode.xs +____________________________________________________________________________ +[ 14304] By: jhi on 2002/01/16 16:55:52 + Log: Subject: [PATCH] Fix crypt.t and fs.t tests + From: Paul_GreenVOS@vos.stratus.com + Date: Wed, 16 Jan 02 6:42 est + Message-Id: <200201161143.GAA02292@mailhub1.stratus.com> + Branch: perl + ! t/io/fs.t t/op/crypt.t +____________________________________________________________________________ +[ 14303] By: jhi on 2002/01/16 14:55:57 + Log: Subject: Re: [PATCH] length of undefined $(digit) should warn + From: Rafael Garcia-Suarez + Date: Wed, 16 Jan 2002 13:43:39 +0100 + Message-ID: <20020116134339.A704@rafael> + + (replaces #14302) + Branch: perl + ! mg.c t/lib/warnings/mg +____________________________________________________________________________ +[ 14302] By: jhi on 2002/01/16 13:47:58 + Log: (replaced by #14303) + Subject: [PATCH] length of undefined $(digit) should warn + From: Rafael Garcia-Suarez + Date: Tue, 15 Jan 2002 23:02:44 +0100 + Message-ID: <20020115230244.A31786@rafael> + Branch: perl + ! mg.c t/lib/warnings/mg +____________________________________________________________________________ +[ 14301] By: jhi on 2002/01/16 13:45:20 + Log: The non-MakeMaker.pm parts of + + Subject: [PATCH] Re: MM_Beos.pm? + From: Tels + Date: Mon, 14 Jan 2002 21:00:31 +0100 (CET) + Message-Id: <200201142006.WAA29544@taas.iki.fi> + Branch: perl + ! ext/SDBM_File/sdbm/Makefile.PL lib/ExtUtils/MM_Unix.pm + ! lib/ExtUtils/t/MM_Unix.t +____________________________________________________________________________ +[ 14300] By: jhi on 2002/01/16 13:40:53 + Log: Subject: [PATCH] Re: [PATCH] strictifying ExtUtils::MakeMaker, take 3 + From: Michael G Schwern + Date: Tue, 15 Jan 2002 20:07:50 -0500 + Message-ID: <20020116010750.GH625@blackrider> + Branch: perl + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 14299] By: jhi on 2002/01/16 13:37:41 + Log: Subject: [PATCH] lib/Text/Tabs.pm doc format touchup + From: Jeffrey Friedl + Date: Tue, 15 Jan 2002 15:30:22 -0800 (PST) + Message-Id: <200201152330.g0FNUM784820@ventrue.corp.yahoo.com> + Branch: perl + ! lib/Text/Tabs.pm +____________________________________________________________________________ +[ 14298] By: jhi on 2002/01/16 13:34:29 + Log: Subject: [PATCH] Tidy up EXE_EXT patches to MM_Unix.pm + From: "Green, Paul" + Date: Tue, 15 Jan 2002 22:28:10 -0500 + Message-ID: <95AE3CDB3543D511883A0020485B38B9023534F0@exna3.stratus.com> + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 14297] By: jhi on 2002/01/16 13:21:26 + Log: Integrate perlio; offsetof() is in + Branch: perl + !> ext/Socket/Socket.xs +____________________________________________________________________________ +[ 14294] By: jhi on 2002/01/16 05:37:29 + Log: Jeffrey's Unicode adventure continues: unify the In/*.pl + and Is/*.pl to lib/*.pl, remove In.pl and Is.pl, introduce + Canonical.pl and Exact.pl. + Branch: perl + + (add 259 files) + - (delete 288 files) + ! MANIFEST lib/unicore/Makefile lib/unicore/Properties + ! lib/unicore/To/Digit.pl lib/unicore/To/Fold.pl + ! lib/unicore/To/Lower.pl lib/unicore/To/Title.pl + ! lib/unicore/To/Upper.pl lib/unicore/mktables lib/utf8_heavy.pl +____________________________________________________________________________ +[ 14293] By: jhi on 2002/01/16 00:32:27 + Log: s/SvPV/SvPVbyte/g, as suggested by Gisle Aas. + Branch: perl + ! ext/Socket/Socket.xs +____________________________________________________________________________ +[ 14292] By: jhi on 2002/01/15 20:06:49 + Log: Subject: [PATCH] Add Slab_Free to embed.fnc + From: "Mattia Barbon" + Date: Tue, 15 Jan 2002 21:59:19 +0100 + Message-ID: <3C44A637.16602.25EB208@localhost> + Branch: perl + ! embed.fnc embed.h proto.h +____________________________________________________________________________ +[ 14291] By: jhi on 2002/01/15 20:00:02 + Log: Duh. The updated In/*.pl weren't checked in. + Branch: perl + ! lib/unicore/In/Alphabet.pl lib/unicore/In/Arabic.pl + ! lib/unicore/In/ArabicP2.pl lib/unicore/In/ArabicPr.pl + ! lib/unicore/In/Armenian.pl lib/unicore/In/Arrows.pl + ! lib/unicore/In/BasicLat.pl lib/unicore/In/Bengali.pl + ! lib/unicore/In/BlockEle.pl lib/unicore/In/Bopomof2.pl + ! lib/unicore/In/Bopomofo.pl lib/unicore/In/BoxDrawi.pl + ! lib/unicore/In/BrailleP.pl lib/unicore/In/Byzantin.pl + ! lib/unicore/In/Cherokee.pl lib/unicore/In/CjkComp2.pl + ! lib/unicore/In/CjkComp3.pl lib/unicore/In/CjkComp4.pl + ! lib/unicore/In/CjkCompa.pl lib/unicore/In/CjkRadic.pl + ! lib/unicore/In/CjkSymbo.pl lib/unicore/In/CjkUnif2.pl + ! lib/unicore/In/CjkUnif3.pl lib/unicore/In/CjkUnifi.pl + ! lib/unicore/In/Combini2.pl lib/unicore/In/Combini3.pl + ! lib/unicore/In/Combinin.pl lib/unicore/In/ControlP.pl + ! lib/unicore/In/Currency.pl lib/unicore/In/Cyrillic.pl + ! lib/unicore/In/Deseret.pl lib/unicore/In/Devanaga.pl + ! lib/unicore/In/Dingbats.pl lib/unicore/In/Enclose2.pl + ! lib/unicore/In/Enclosed.pl lib/unicore/In/Ethiopic.pl + ! lib/unicore/In/GeneralP.pl lib/unicore/In/Geometri.pl + ! lib/unicore/In/Georgian.pl lib/unicore/In/Gothic.pl + ! lib/unicore/In/Greek.pl lib/unicore/In/GreekExt.pl + ! lib/unicore/In/Gujarati.pl lib/unicore/In/Gurmukhi.pl + ! lib/unicore/In/Halfwidt.pl lib/unicore/In/HangulCo.pl + ! lib/unicore/In/HangulJa.pl lib/unicore/In/HangulSy.pl + ! lib/unicore/In/Hebrew.pl lib/unicore/In/HighPriv.pl + ! lib/unicore/In/HighSurr.pl lib/unicore/In/Hiragana.pl + ! lib/unicore/In/Ideograp.pl lib/unicore/In/IpaExten.pl + ! lib/unicore/In/Kanbun.pl lib/unicore/In/KangxiRa.pl + ! lib/unicore/In/Kannada.pl lib/unicore/In/Katakana.pl + ! lib/unicore/In/Khmer.pl lib/unicore/In/Lao.pl + ! lib/unicore/In/Latin1Su.pl lib/unicore/In/LatinEx2.pl + ! lib/unicore/In/LatinEx3.pl lib/unicore/In/LatinExt.pl + ! lib/unicore/In/Letterli.pl lib/unicore/In/LowSurro.pl + ! lib/unicore/In/Malayala.pl lib/unicore/In/Mathema2.pl + ! lib/unicore/In/Mathemat.pl lib/unicore/In/Miscell2.pl + ! lib/unicore/In/Miscella.pl lib/unicore/In/Mongolia.pl + ! lib/unicore/In/MusicalS.pl lib/unicore/In/Myanmar.pl + ! lib/unicore/In/NumberFo.pl lib/unicore/In/Ogham.pl + ! lib/unicore/In/OldItali.pl lib/unicore/In/OpticalC.pl + ! lib/unicore/In/Oriya.pl lib/unicore/In/PrivateU.pl + ! lib/unicore/In/Runic.pl lib/unicore/In/Sinhala.pl + ! lib/unicore/In/SmallFor.pl lib/unicore/In/SpacingM.pl + ! lib/unicore/In/Specials.pl lib/unicore/In/Superscr.pl + ! lib/unicore/In/Syriac.pl lib/unicore/In/Tags.pl + ! lib/unicore/In/Tamil.pl lib/unicore/In/Telugu.pl + ! lib/unicore/In/Thaana.pl lib/unicore/In/Thai.pl + ! lib/unicore/In/Tibetan.pl lib/unicore/In/UnifiedC.pl + ! lib/unicore/In/YiRadica.pl lib/unicore/In/YiSyllab.pl +____________________________________________________________________________ +[ 14290] By: jhi on 2002/01/15 18:39:54 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ [ 14289] By: jhi on 2002/01/15 18:38:03 Log: Jeffrey is trying very hard to avoid working on his book, it would seem :-) (better naming, better comments diff --git a/MANIFEST b/MANIFEST index f8a6289..605acf0 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2343,7 +2343,7 @@ t/pod/testpchk.pl Module to test Pod::Checker for a given file t/pod/testpods/lib/Pod/Stuff.pm Sample data for find.t t/README Instructions for regression tests t/run/exit.t Test perl's exit status. -t/run/kill_perl.t Tests that kill perl. +t/run/fresh_perl.t Tests that require a fresh perl. t/run/noswitch.t Test aliasing ARGV for other switch tests t/run/runenv.t Test if perl honors its environment variables. t/run/switcha.t Test the -a switch diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs index 8026964..6ad7107 100644 --- a/ext/Opcode/Opcode.xs +++ b/ext/Opcode/Opcode.xs @@ -62,7 +62,7 @@ op_names_init(pTHX) bitmap = SvPV(opset_all, len); i = len-1; /* deal with last byte specially, see below */ while(i-- > 0) - bitmap[i] = 0xFF; + bitmap[i] = (char)0xFF; /* Take care to set the right number of bits in the last byte */ bitmap[len-1] = (PL_maxo & 0x07) ? ~(0xFF << (PL_maxo & 0x07)) : 0xFF; put_op_bitspec(aTHX_ ":all",0, opset_all); /* don't mortalise */ diff --git a/ext/SDBM_File/sdbm/Makefile.PL b/ext/SDBM_File/sdbm/Makefile.PL index 4453dea..6de7bd0 100644 --- a/ext/SDBM_File/sdbm/Makefile.PL +++ b/ext/SDBM_File/sdbm/Makefile.PL @@ -1,6 +1,6 @@ use ExtUtils::MakeMaker; -$define = '-DSDBM -DDUFF'; +my $define = '-DSDBM -DDUFF'; $define .= ' -DWIN32 -DPERL_STATIC_SYMS' if ($^O eq 'MSWin32'); if ($^O eq 'VMS') { # Old VAXC compiler can't handle Duff's device diff --git a/ext/Unicode/Normalize/Normalize.pm b/ext/Unicode/Normalize/Normalize.pm index 819fbc4..eed1858 100644 --- a/ext/Unicode/Normalize/Normalize.pm +++ b/ext/Unicode/Normalize/Normalize.pm @@ -106,8 +106,8 @@ As C<$form_name>, one of the following names must be given. =head2 Character Data These functions are interface of character data used internally. -If you want only to get unicode normalization forms, -you doesn't need call them by yourself. +If you want only to get Unicode normalization forms, you don't need +call them yourself. =over 4 diff --git a/lib/Attribute/Handlers.pm b/lib/Attribute/Handlers.pm index f12d1d9..d4cbfff 100644 --- a/lib/Attribute/Handlers.pm +++ b/lib/Attribute/Handlers.pm @@ -145,7 +145,11 @@ sub _gen_handler_AH_() { _apply_handler_AH_($decl,$gphase) if $global_phases{$gphase} <= $global_phase; } - push @declarations, $decl; + # if _gen_handler_AH_ is being called after CHECK it's + # for a lexical, so we don't want to keep a reference + # around + push @declarations, $decl + if $global_phase == 0; } $_ = undef; } diff --git a/lib/Attribute/Handlers/t/multi.t b/lib/Attribute/Handlers/t/multi.t index cc57889..c327b39 100644 --- a/lib/Attribute/Handlers/t/multi.t +++ b/lib/Attribute/Handlers/t/multi.t @@ -131,3 +131,37 @@ $noisy[0]++; my %rowdy : Rowdy(37,'this arg should be ignored'); $rowdy{key}++; + +# check that applying attributes to lexicals doesn't unduly worry +# their refcounts +my $out = "begin\n"; +my $applied; +sub UNIVERSAL::Dummy :ATTR { ++$applied }; +sub Dummy::DESTROY { $out .= "bye\n" } + +{ my $dummy; $dummy = bless {}, 'Dummy'; } +ok( $out eq "begin\nbye\n", 45 ); + +{ my $dummy : Dummy; $dummy = bless {}, 'Dummy'; } +ok( $out eq "begin\nbye\nbye\n", 46 ); + +# are lexical attributes reapplied correctly? +sub dummy { my $dummy : Dummy; } +$applied = 0; +dummy(); dummy(); +ok( $applied == 2, 47 ); + +# 45-47 again, but for our variables +$out = "begin\n"; +{ our $dummy; $dummy = bless {}, 'Dummy'; } +ok( $out eq "begin\n", 48 ); +{ our $dummy : Dummy; $dummy = bless {}, 'Dummy'; } +ok( $out eq "begin\nbye\n", 49 ); +undef $::dummy; +ok( $out eq "begin\nbye\nbye\n", 50 ); + +# are lexical attributes reapplied correctly? +sub dummy_our { our $banjo : Dummy; } +$applied = 0; +dummy_our(); dummy_our(); +ok( $applied == 0, 51 ); diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index 24e36a1..249954d 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -11,7 +11,7 @@ use strict; our ($Is_Mac,$Is_OS2,$Is_VMS,$Is_Win32,$Is_Dos, $Verbose,%pm,%static,$Xsubpp_Version); -our $VERSION = '1.12606'; +our $VERSION = '1.12607'; require ExtUtils::MakeMaker; ExtUtils::MakeMaker->import(qw($Verbose &neatvalue)); @@ -2027,21 +2027,20 @@ usually solves this kind of problem. push @defpath, $component if defined $component; } - my @perls = ($self->canonpath($^X), 'perl', 'perl5', "perl$Config{version}"); + # Build up a set of file names (not command names). + my $thisperl = $self->canonpath($^X); + $thisperl .= $Config{exe_ext} unless $thisperl =~ m/$Config{exe_ext}$/i; + my @perls = ('perl', 'perl5', "perl$Config{version}"); + @perls = ($thisperl, (map $_.=$Config{exe_ext}, @perls)); - # miniperl has priority over all but the cannonical perl when in the + # miniperl has priority over all but the cannonical perl when in the # core. Otherwise its a last resort. + my $miniperl = "miniperl$Config{exe_ext}"; if( $self->{PERL_CORE} ) { - splice @perls, 1, 0, 'miniperl'; + splice @perls, 1, 0, $miniperl; } else { - push @perls, 'miniperl'; - } - - # Build up a set of file names (not command names). - foreach $element (@perls) { - $element .= $Config{exe_ext} - unless $element =~ m/$Config{exe_ext}$/i; + push @perls, $miniperl; } $self->{PERL} ||= @@ -3899,14 +3898,13 @@ sub xs_o { # many makes are too dumb to use xs_c then c_o =item perl_archive This is internal method that returns path to libperl.a equivalent -to be linked to dynamic extensions. UNIX does not have one but OS2 -and Win32 do. +to be linked to dynamic extensions. UNIX does not have one but other +OSs might have one. =cut sub perl_archive { - return '$(PERL_INC)' . "/$Config{libperl}" if $^O eq "beos"; return ""; } diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index f7aec61..08caa7b 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -2,7 +2,7 @@ BEGIN {require 5.002;} # MakeMaker 5.17 was the last MakeMaker that was compatib package ExtUtils::MakeMaker; -$VERSION = "5.47"; +$VERSION = "5.48"; $Version_OK = "5.17"; # Makefiles older than $Version_OK will die # (Will be checked from MakeMaker version 4.13 onwards) ($Revision = substr(q$Revision: 1.222 $, 10)) =~ s/\s+$//; @@ -12,18 +12,15 @@ $Version_OK = "5.17"; # Makefiles older than $Version_OK will die require Exporter; use Config; use Carp (); -#use FileHandle (); use vars qw( - @ISA @EXPORT @EXPORT_OK $AUTOLOAD - $ISA_TTY $Is_Mac $Is_OS2 $Is_VMS $Revision - $VERSION $Verbose $Version_OK %Config %Keep_after_flush - %MM_Sections %Prepend_dot_dot %Recognized_Att_Keys - @Get_from_Config @MM_Sections @Overridable @Parent - + $ISA_TTY $Revision $VERSION $Verbose $Version_OK %Config + %Keep_after_flush %MM_Sections %Prepend_dot_dot + %Recognized_Att_Keys @Get_from_Config @MM_Sections @Overridable + @Parent $PACKNAME ); -# use strict; +use strict; # &DynaLoader::mod2fname should be available to miniperl, thus # should be a pseudo-builtin (cmp. os2.c). @@ -66,12 +63,13 @@ package ExtUtils::MakeMaker; # # Now we can pull in the friends # -$Is_VMS = $^O eq 'VMS'; -$Is_OS2 = $^O eq 'os2'; -$Is_Mac = $^O eq 'MacOS'; -$Is_Win32 = $^O eq 'MSWin32'; -$Is_Cygwin = $^O eq 'cygwin'; -$Is_NetWare = $Config{'osname'} eq 'NetWare'; +my $Is_VMS = $^O eq 'VMS'; +my $Is_OS2 = $^O eq 'os2'; +my $Is_Mac = $^O eq 'MacOS'; +my $Is_Win32 = $^O eq 'MSWin32'; +my $Is_Cygwin = $^O eq 'cygwin'; +my $Is_NetWare = $Config{osname} eq 'NetWare'; +my $Is_BeOS = $^O =~ /beos/i; # XXX should this be that loose? require ExtUtils::MM_Unix; @@ -95,6 +93,9 @@ if ($Is_Win32) { if ($Is_Cygwin) { require ExtUtils::MM_Cygwin; } +if ($Is_BeOS) { + require ExtUtils::MM_BeOS; +} full_setup(); @@ -148,12 +149,11 @@ sub prompt ($;$) { sub eval_in_subdirs { my($self) = @_; - my($dir); use Cwd qw(cwd abs_path); my $pwd = cwd(); local @INC = map eval {abs_path($_) if -e} || $_, @INC; - foreach $dir (@{$self->{DIR}}){ + foreach my $dir (@{$self->{DIR}}){ my($abs) = $self->catdir($pwd,$dir); $self->eval_in_x($abs); } @@ -164,16 +164,8 @@ sub eval_in_x { my($self,$dir) = @_; package main; chdir $dir or Carp::carp("Couldn't change to directory $dir: $!"); -# use FileHandle (); -# my $fh = new FileHandle; -# $fh->open("Makefile.PL") or Carp::carp("Couldn't open Makefile.PL in $dir"); - local *FH; - open(FH,"Makefile.PL") or Carp::carp("Couldn't open Makefile.PL in $dir"); -# my $eval = join "", <$fh>; - my $eval = join "", ; -# $fh->close; - close FH; - eval $eval; + + eval { do './Makefile.PL' }; if ($@) { # if ($@ =~ /prerequisites/) { # die "MakeMaker WARNING: $@"; @@ -190,7 +182,7 @@ sub full_setup { # package name for the classes into which the first object will be blessed $PACKNAME = "PACK000"; - @Attrib_help = qw/ + my @attrib_help = qw/ AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION C CAPI CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS @@ -273,11 +265,10 @@ sub full_setup { exe_ext full_ar ); - my $item; - foreach $item (@Attrib_help){ + foreach my $item (@attrib_help){ $Recognized_Att_Keys{$item} = 1; } - foreach $item (@Get_from_Config) { + foreach my $item (@Get_from_Config) { $Recognized_Att_Keys{uc $item} = $Config{$item}; print "Attribute '\U$item\E' => '$Config{$item}'\n" if ($Verbose >= 2); @@ -351,10 +342,8 @@ sub ExtUtils::MakeMaker::new { my(%initial_att) = %$self; # record initial attributes my(%unsatisfied) = (); - my($prereq); - foreach $prereq (sort keys %{$self->{PREREQ_PM}}) { - my $eval = "require $prereq"; - eval $eval; + foreach my $prereq (sort keys %{$self->{PREREQ_PM}}) { + eval "require $prereq"; if ($@) { warn "Warning: prerequisite $prereq $self->{PREREQ_PM}->{$prereq} not found.\n" unless $self->{PREREQ_FATAL}; @@ -403,7 +392,7 @@ sub ExtUtils::MakeMaker::new { my $newclass = ++$PACKNAME; local @Parent = @Parent; # Protect against non-local exits { -# no strict; + no strict 'refs'; print "Blessing Object into class [$newclass]\n" if $Verbose>=2; mv_all_methods("MY",$newclass); bless $self, $newclass; @@ -491,7 +480,7 @@ END # MakeMaker Parameters: END - foreach $key (sort keys %initial_att){ + foreach my $key (sort keys %initial_att){ my($v) = neatvalue($initial_att{$key}); $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/; $v =~ tr/\n/ /s; @@ -505,7 +494,7 @@ END # MakeMaker 'CONFIGURE' Parameters: END if (scalar(keys %configure_att) > 0) { - foreach $key (sort keys %configure_att){ + foreach my $key (sort keys %configure_att){ my($v) = neatvalue($configure_att{$key}); $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/; $v =~ tr/\n/ /s; @@ -538,8 +527,7 @@ END $self->eval_in_subdirs if @{$self->{DIR}}; } - my $section; - foreach $section ( @MM_Sections ){ + foreach my $section ( @MM_Sections ){ print "Processing Makefile '$section' section\n" if ($Verbose >= 2); my($skipit) = $self->skipcheck($section); if ($skipit){ @@ -589,9 +577,10 @@ EOP sub check_manifest { print STDOUT "Checking if your kit is complete...\n"; require ExtUtils::Manifest; - $ExtUtils::Manifest::Quiet=$ExtUtils::Manifest::Quiet=1; #avoid warning - my(@missed)=ExtUtils::Manifest::manicheck(); - if (@missed){ + # avoid warning + $ExtUtils::Manifest::Quiet = $ExtUtils::Manifest::Quiet = 1; + my(@missed) = ExtUtils::Manifest::manicheck(); + if (@missed) { print STDOUT "Warning: the following files are missing in your kit:\n"; print "\t", join "\n\t", @missed; print STDOUT "\n"; @@ -603,14 +592,14 @@ sub check_manifest { sub parse_args{ my($self, @args) = @_; - foreach (@args){ - unless (m/(.*?)=(.*)/){ + foreach (@args) { + unless (m/(.*?)=(.*)/) { help(),exit 1 if m/^help$/; ++$Verbose if m/^verb/; next; } my($name, $value) = ($1, $2); - if ($value =~ m/^~(\w+)?/){ # tilde with optional username + if ($value =~ m/^~(\w+)?/) { # tilde with optional username $value =~ s [^~(\w*)] [$1 ? ((getpwnam($1))[7] || "~$1") : @@ -660,8 +649,8 @@ sub parse_args{ if (defined $self->{EXCLUDE_EXT} && ref \$self->{EXCLUDE_EXT} eq 'SCALAR') { $self->{EXCLUDE_EXT} = [grep $_, split '\s+', $self->{EXCLUDE_EXT}]; } - my $mmkey; - foreach $mmkey (sort keys %$self){ + + foreach my $mmkey (sort keys %$self){ print STDOUT " $mmkey => ", neatvalue($self->{$mmkey}), "\n" if $Verbose; print STDOUT "'$mmkey' is not a known MakeMaker parameter name.\n" unless exists $Recognized_Att_Keys{$mmkey}; @@ -676,7 +665,6 @@ sub check_hints { return unless -d "hints"; # First we look for the best hintsfile we have - my(@goodhints); my($hint)="${^O}_$Config{osvers}"; $hint =~ s/\./_/g; $hint =~ s/_$//; @@ -691,32 +679,22 @@ sub check_hints { return unless -f "hints/$hint.pl"; # really there # execute the hintsfile: -# use FileHandle (); -# my $fh = new FileHandle; -# $fh->open("hints/$hint.pl"); - local *FH; - open(FH,"hints/$hint.pl"); -# @goodhints = <$fh>; - @goodhints = ; -# $fh->close; - close FH; print STDOUT "Processing hints file hints/$hint.pl\n"; - eval join('',@goodhints); + eval { do "hints/$hint.pl" }; print STDOUT $@ if $@; } sub mv_all_methods { my($from,$to) = @_; - my($method); + no strict 'refs'; my($symtab) = \%{"${from}::"}; -# no strict; # Here you see the *current* list of methods that are overridable # from Makefile.PL via MY:: subroutines. As of VERSION 5.07 I'm # still trying to reduce the list to some reasonable minimum -- # because I want to make it easier for the user. A.K. - foreach $method (@Overridable) { + foreach my $method (@Overridable) { # We cannot say "next" here. Nick might call MY->makeaperl # which isn't defined right now @@ -845,9 +823,9 @@ sub neatvalue { my($t) = ref $v; return "q[$v]" unless $t; if ($t eq 'ARRAY') { - my(@m, $elem, @neat); + my(@m, @neat); push @m, "["; - foreach $elem (@$v) { + foreach my $elem (@$v) { push @neat, "q[$elem]"; } push @m, join ", ", @neat; @@ -868,7 +846,7 @@ sub selfdocument { my(@m); if ($Verbose){ push @m, "\n# Full list of MakeMaker attribute values:"; - foreach $key (sort keys %$self){ + foreach my $key (sort keys %$self){ next if $key eq 'RESULT' || $key =~ /^[A-Z][a-z]/; my($v) = neatvalue($self->{$key}); $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/; diff --git a/lib/ExtUtils/t/MM_Unix.t b/lib/ExtUtils/t/MM_Unix.t index aea777b..fec24ca 100644 --- a/lib/ExtUtils/t/MM_Unix.t +++ b/lib/ExtUtils/t/MM_Unix.t @@ -3,6 +3,7 @@ # 2001-12-16 Tels first version # 2002-01-13 Tels 0.02 added some tests for various functions, added Andreas # fix to the version test (>= vs ==) +# 2002-01-14 Tels 0.03 exclude on beos and netware, /i for $^O test BEGIN { chdir 't' if -d 't'; @@ -12,7 +13,7 @@ BEGIN { BEGIN { use Test::More; - if( $^O =~ /^VMS|os2|MacOS|MSWin32|cygwin$/ ) { + if( $^O =~ /^VMS|os2|MacOS|MSWin32|cygwin|beos|netware$/i ) { plan skip_all => 'Non-Unix platform'; } else { diff --git a/lib/Text/Tabs.pm b/lib/Text/Tabs.pm index c431019..b26f8f4 100644 --- a/lib/Text/Tabs.pm +++ b/lib/Text/Tabs.pm @@ -73,11 +73,11 @@ Text::Tabs -- expand and unexpand tabs per the unix expand(1) and unexpand(1) =head1 SYNOPSIS -use Text::Tabs; + use Text::Tabs; -$tabstop = 4; -@lines_without_tabs = expand(@lines_with_tabs); -@lines_with_tabs = unexpand(@lines_without_tabs); + $tabstop = 4; + @lines_without_tabs = expand(@lines_with_tabs); + @lines_with_tabs = unexpand(@lines_without_tabs); =head1 DESCRIPTION diff --git a/mg.c b/mg.c index 49f8bc4..c7ebca3 100644 --- a/mg.c +++ b/mg.c @@ -458,6 +458,14 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg) Perl_croak(aTHX_ "panic: magic_len: %"IVdf, (IV)i); return i; } + else { + if (ckWARN(WARN_UNINITIALIZED)) + report_uninit(); + } + } + else { + if (ckWARN(WARN_UNINITIALIZED)) + report_uninit(); } return 0; case '+': diff --git a/patchlevel.h b/patchlevel.h index c174ac5..8e3e282 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -70,7 +70,7 @@ #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { NULL - ,"DEVEL14289" + ,"DEVEL14309" ,NULL }; diff --git a/scope.c b/scope.c index 59adddf..3303011 100644 --- a/scope.c +++ b/scope.c @@ -693,7 +693,9 @@ Perl_leave_scope(pTHX_ I32 base) DEBUG_S(PerlIO_printf(Perl_debug_log, "restore svref: %p %p:%s -> %p:%s\n", ptr, sv, SvPEEK(sv), value, SvPEEK(value))); - if (SvTYPE(sv) == SVt_PVMG && SvMAGIC(sv)) { + if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) && + SvTYPE(sv) != SVt_PVGV) + { (void)SvUPGRADE(value, SvTYPE(sv)); SvMAGIC(value) = SvMAGIC(sv); SvFLAGS(value) |= SvMAGICAL(sv); @@ -705,7 +707,9 @@ Perl_leave_scope(pTHX_ I32 base) * croaking that might ensue when the SvSETMAGIC() below is * called, or to avoid two different SVs pointing at the same * SvMAGIC()). This needs a total rethink. --GSAR */ - else if (SvTYPE(value) == SVt_PVMG && SvMAGIC(value)) { + else if (SvTYPE(value) >= SVt_PVMG && SvMAGIC(value) && + SvTYPE(value) != SVt_PVGV) + { SvFLAGS(value) |= (SvFLAGS(value) & (SVp_NOK|SVp_POK)) >> PRIVSHIFT; SvMAGICAL_off(value); diff --git a/t/io/fs.t b/t/io/fs.t index 7331cd4..3eb3e0a 100755 --- a/t/io/fs.t +++ b/t/io/fs.t @@ -239,7 +239,7 @@ close(IOFSCOM); SKIP: { eval { truncate "Iofs.tmp", 5; }; - skip("no truncate - $@", 4) if $@; + skip("no truncate - $@", 6) if $@; is(-s "Iofs.tmp", 5, "truncation to five bytes"); diff --git a/t/lib/warnings/mg b/t/lib/warnings/mg index f224335..2190638 100644 --- a/t/lib/warnings/mg +++ b/t/lib/warnings/mg @@ -42,3 +42,16 @@ $|=1; $SIG{"INT"} = "fred"; kill "INT",$$; EXPECT +######## +# mg.c +use warnings 'uninitialized'; +'foo' =~ /(foo)/; +length $3; +EXPECT +Use of uninitialized value in length at - line 4. +######## +# mg.c +use warnings 'uninitialized'; +length $3; +EXPECT +Use of uninitialized value in length at - line 3. diff --git a/t/op/crypt.t b/t/op/crypt.t index d11a2a0..27c878f 100644 --- a/t/op/crypt.t +++ b/t/op/crypt.t @@ -28,7 +28,10 @@ BEGIN { # bets, given alternative encryption/hashing schemes like MD5, # C2 (or higher) security schemes, and non-UNIX platforms. -ok(substr(crypt("ab", "cd"), 2) ne substr(crypt("ab", "ce"), 2), "salt makes a difference"); +SKIP: { + skip ("VOS crypt ignores salt.", 1) if ($^O eq 'vos'); + ok(substr(crypt("ab", "cd"), 2) ne substr(crypt("ab", "ce"), 2), "salt makes a difference"); +} $a = "a\xFF\x{100}"; diff --git a/t/run/kill_perl.t b/t/run/fresh_perl.t similarity index 97% rename from t/run/kill_perl.t rename to t/run/fresh_perl.t index 3ee2831..73680eb 100644 --- a/t/run/kill_perl.t +++ b/t/run/fresh_perl.t @@ -2,7 +2,7 @@ # ** DO NOT ADD ANY MORE TESTS HERE ** # Instead, put the test in the appropriate test file and use the -# kill_perl() function in t/test.pl. +# fresh_perl_is()/fresh_perl_like() functions in t/test.pl. # This is for tests that will normally cause segfaults, and other nasty # errors that might kill the interpreter and for some reason you can't @@ -52,7 +52,9 @@ foreach my $prog (@prgs) { my($prog,$expected) = split(/\nEXPECT\n/, $raw_prog); - kill_perl($prog, $expected, { switches => [$switch] }, $name); + $expected =~ s/\n+$//; + + fresh_perl_is($prog, $expected, { switches => [$switch] }, $name); } __END__ @@ -280,7 +282,7 @@ print "ok\n" if ("\0" lt "\xFF"); EXPECT ok ######## -open(H,'run/kill_perl.t'); # must be in the 't' directory +open(H,'run/fresh_perl.t'); # must be in the 't' directory stat(H); print "ok\n" if (-e _ and -f _ and -r _); EXPECT @@ -756,18 +758,6 @@ ok print join '', @a, "\n"; EXPECT 123456789 -######## [ID 20010912.007] segfault or "Can't modify non-existent substring" -$b="abcde"; -$s = \substr($b, 2, 1); -print "before: $$s\n"; -{ - local $k; - *k = $s; -} -print "after: $$s\n"; -EXPECT -before: c -after: c ######## [ID 20020104.007] "coredump on dbmclose" package Foo; eval { dbmclose %h }; # not all places have dbm* functions diff --git a/t/test.pl b/t/test.pl index 379e136..a00dd5e 100644 --- a/t/test.pl +++ b/t/test.pl @@ -396,8 +396,16 @@ my $tmpfile = "misctmp000"; 1 while -f ++$tmpfile; END { unlink_all $tmpfile } -sub kill_perl { - my($prog, $expected, $runperl_args, $name) = @_; +# +# _fresh_perl +# +# The $resolve must be a subref that tests the first argument +# for success, or returns the definition of success (e.g. the +# expected scalar) if given no arguments. +# + +sub _fresh_perl { + my($prog, $resolve, $runperl_args, $name) = @_; $runperl_args ||= {}; $runperl_args->{progfile} = $tmpfile; @@ -437,19 +445,45 @@ sub kill_perl { $results =~ s/\n\n/\n/g; } - $expected =~ s/\n+$//; - - my $pass = $results eq $expected; + my $pass = $resolve->($results); unless ($pass) { print STDERR "# PROG: $switch\n$prog\n"; - print STDERR "# EXPECTED:\n$expected\n"; + print STDERR "# EXPECTED:\n", $resolve->(), "\n"; print STDERR "# GOT:\n$results\n"; print STDERR "# STATUS: $status\n"; } ($name) = $prog =~ /^(.{1,35})/ unless $name; - _ok($pass, _where(), "kill_perl - $name"); + _ok($pass, _where(), "fresh_perl - $name"); +} + +# +# run_perl_is +# +# Combination of run_perl() and is(). +# + +sub fresh_perl_is { + my($prog, $expected, $runperl_args, $name) = @_; + _fresh_perl($prog, + sub { @_ ? $_[0] eq $expected : $expected }, + $runperl_args, $name); +} + +# +# run_perl_like +# +# Combination of run_perl() and like(). +# + +sub fresh_perl_like { + my($prog, $expected, $runperl_args, $name) = @_; + _fresh_perl($prog, + sub { @_ ? + $_[0] =~ (ref $expected ? $expected : /$expected/) : + $expected }, + $runperl_args, $name); } 1;