diff options
author | Todd C. Miller <millert@cvs.openbsd.org> | 2005-01-15 21:30:44 +0000 |
---|---|---|
committer | Todd C. Miller <millert@cvs.openbsd.org> | 2005-01-15 21:30:44 +0000 |
commit | c2276cd9a1ad823a3a292bd9ea5d0475bb983737 (patch) | |
tree | d3828d43e8271c783c6683783ad627b4232d3672 | |
parent | c30a36e0c140753f3f773b400f5dbc777b344b8a (diff) |
sync in-tree perl with 5.8.6
134 files changed, 11104 insertions, 3980 deletions
diff --git a/gnu/usr.bin/perl/Changes b/gnu/usr.bin/perl/Changes index 59b5bfa588f..ba81d3f657f 100644 --- a/gnu/usr.bin/perl/Changes +++ b/gnu/usr.bin/perl/Changes @@ -25,1379 +25,1650 @@ to the perl5-porters mailing list. You can retrieve the messages for example from http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/ -------------- -Version v5.8.5 Maintenance release working toward v5.8.5 +Version v5.8.6 Maintenance release working toward v5.8.6 -------------- ____________________________________________________________________________ -[ 23139] By: nicholas on 2004/07/19 13:43:44 - Log: Oops. Forgot to mention the threads fix. +[ 23552] By: nicholas on 2004/11/27 15:14:36 + Log: Entry for PERL_USE_SAFE_PUTENV, reworded slightly from an original + by Stas Bekman Branch: maint-5.8/perl - ! pod/perl585delta.pod + ! pod/perl586delta.pod ____________________________________________________________________________ -[ 23138] By: nicholas on 2004/07/19 13:01:47 - Log: Update the perldelta. +[ 23551] By: nicholas on 2004/11/27 15:07:10 + Log: Integrate: + [ 23546] + Doc nit for B::Lint + Subject: [PATCH] B::Lint + From: Andy Lester <andy@petdance.com> + Date: Fri, 26 Nov 2004 00:30:48 -0600 + Message-ID: <20041126063048.GA10161@petdance.com> + + [ 23549] + Document the interaction of PERL_USE_SAVE_PUTENV and + PL_use_safe_putenv, based on text by Stas Bekman + + [ 23550] + Clarify the return values of pos, particularly 0 and undef, as + suggested by Stas Bekman Branch: maint-5.8/perl - ! pod/perl585delta.pod + !> INSTALL ext/B/B/Lint.pm pod/perlfunc.pod ____________________________________________________________________________ -[ 23137] By: nicholas on 2004/07/19 12:43:07 +[ 23540] By: nicholas on 2004/11/25 22:34:55 Log: Update Changes Branch: maint-5.8/perl ! Changes patchlevel.h ____________________________________________________________________________ -[ 23136] By: nicholas on 2004/07/19 12:27:41 +[ 23539] By: nicholas on 2004/11/25 22:21:23 Log: Integrate: - [ 23042] - Bump $B::Deparse::VERSION + [ 23532] + Subject: [perl #3242] [PATCH]No error on assignment to $> + From: "Steve Peters via RT" <perlbug-followup@perl.org> + Date: 21 Nov 2004 04:38:09 -0000 + Message-ID: <rt-3.0.11-3242-100676.6.32723019025057@perl.org> + + [ 23533] + Subject: [patch pod/perlipc] use POSIX; w/o () is a bad idea + From: Stas Bekman <stas@stason.org> + Date: Wed, 24 Nov 2004 11:25:14 -0500 + Message-ID: <41A4B5EA.3020804@stason.org> + + [ 23534] + Subject: RC1 pod fix #anchor + From: Stas Bekman <stas@stason.org> + Date: Wed, 24 Nov 2004 10:57:21 -0500 + Message-ID: <41A4AF61.9080408@stason.org> Branch: maint-5.8/perl - !> ext/B/B/Deparse.pm + !> pod/perlipc.pod pod/perlrun.pod pod/perlvar.pod ____________________________________________________________________________ -[ 23134] By: nicholas on 2004/07/17 09:40:46 - Log: New sample config files. +[ 23530] By: nicholas on 2004/11/23 22:49:13 + Log: Integrate: + [ 23518] + Subject: [perl #32486] error in documentation for POSIX::pipe + From: chris@ex-parrot.com (via RT) <perlbug-followup@perl.org> + Date: 18 Nov 2004 18:09:54 -0000 + Message-ID: <rt-3.0.11-32486-100537.1.04456486825399@perl.org> + + [ 23527] + Subject: Re: [perl #32486] error in documentation for POSIX::pipe + From: Michael G Schwern <schwern@pobox.com> + Date: Fri, 19 Nov 2004 14:28:56 -0500 + Message-ID: <20041119192856.GA4769@windhund.schwern.org> Branch: maint-5.8/perl - ! Porting/config.sh Porting/config_H + !> ext/POSIX/POSIX.pod ____________________________________________________________________________ -[ 23133] By: nicholas on 2004/07/17 09:36:41 +[ 23529] By: nicholas on 2004/11/23 15:17:07 Log: Integrate: - [ 23120] - threads.xs doesn't check the return value of the thread creation - call. D'oh! This gives SEGVs if the OS fails to create another thread. - Cause of problem located by Nigel Sandever + [ 23507] + Subject: SuSE's perl safe_putenf diff + From: Michael Schroeder <Michael.Schroeder@informatik.uni-erlangen.de> + Date: Thu, 11 Nov 2004 15:54:43 +0100 + Message-ID: <20041111145443.GA1854@immd4.informatik.uni-erlangen.de> + + slightly reworked to make the PL_use_safe_putenv variable fit in + the current framework. This patch turns on the use of safe putenv + for any application that embeds a perl interpreter. Branch: maint-5.8/perl - !> ext/threads/threads.pm ext/threads/threads.xs + !> embedvar.h mg.c miniperlmain.c perl.c perlapi.h perlvars.h + !> util.c ____________________________________________________________________________ -[ 23132] By: nicholas on 2004/07/16 14:31:01 +[ 23524] By: nicholas on 2004/11/22 15:20:18 + Log: Back out 23348 from maint, epnding a better way to upgrade DynaLoader's + version number without causing subtle breakages. + Branch: maint-5.8/perl + ! ext/DynaLoader/DynaLoader_pm.PL +____________________________________________________________________________ +[ 23522] By: nicholas on 2004/11/20 16:14:02 Log: Integrate: - [ 23072] - dor and // fulfil a TODO - Correct a deviation from the Nicholas Clark style guide. - - [ 23073] - A more honest TODO - - [ 23077] - Resurrect the TODO items about Unicode filenames and Unicode %ENV - Rant a bit more about POD -> HTML - - [ 23078] - Dual lifing and dists is a TODO - - [ 23081] - Finding a way to put "I'm MAINT" in perl -v is a TODO - - [ 23082] - A decent benchmark would be useful. But it is vague. - - [ 23094] - Generalised "how many in list context" would be useful - - [ 23103] - s/sort/split/; - my mistake spotted by Dave. - - [ 23104] - Some thoughts on foreach reverse - - [ 23107] - Subject: [PATCH] split doc clarification - From: Yitzchak Scott-Thoennes <sthoenna@efn.org> - Date: Wed, 14 Jul 2004 10:19:36 -0700 - Message-Id: <20040714171936.GA1092@efn.org> - - [ 23115] - for (reverse @foo) now iterates in reverse in place. - (Just the TODO change) - - [ 23116] - Abigail notes that a re-entrant regexp engine is a todo + [ 23495] + Subject: [PATCH] Small documentation fix to ExtUtils::Constant + Date: Fri, 12 Nov 2004 11:15:47 -0600 + From: steve@fisharerojo.org + Message-ID: <20041112171547.GA8011@kirk.dsl-verizon.net> - [ 23129] - Typo fix from Julian Gilbey, forwarded upstream from Debian by - Brendan O'Dea - - [ 23130] - Clarify that it's only Mac OS *Classic* that uses 1904 - OS X uses - 1970 + [ 23517] + Bump version number Branch: maint-5.8/perl - !> pod/perlfunc.pod pod/perltodo.pod pod/perluniintro.pod + !> lib/ExtUtils/Constant.pm ____________________________________________________________________________ -[ 23131] By: nicholas on 2004/07/16 14:11:52 +[ 23521] By: nicholas on 2004/11/20 15:20:12 Log: Integrate: - [ 23051] - Add some missing authors and remove 1 duplicate + [ 23513] + Fix deparsing of reversed sort and descending sorts, + due to the recent optimisations on this part of the optree. + + [ 23514] + Fix deparsing of reversed foreach loops, + plus a bug in the previous commit - [ 23127] - glob('*.c') to find documentation is dangerous when run in unclean - trees, so isntead use MANIFEST to only scan the legitimate source - files. + [ 23516] + Remaining nit in the deparsing of reversed foreach loops Branch: maint-5.8/perl - !> AUTHORS autodoc.pl + !> ext/B/B/Deparse.pm ext/B/t/deparse.t ____________________________________________________________________________ -[ 23119] By: nicholas on 2004/07/15 16:38:38 - Log: Integrate: - [ 23118] - Assimilate Cwd 2.19 +[ 23515] By: nicholas on 2004/11/18 21:15:15 + Log: Subject: Re: Proposed patch for perldelta.pod for 5.8.6-RC1 + From: Mike Guy <mjtg@cam.ac.uk> + Message-Id: <E1CUUFq-00006L-H7@virgo.cus.cam.ac.uk> + Date: Wed, 17 Nov 2004 18:10:06 +0000 Branch: maint-5.8/perl - !> ext/Cwd/Changes ext/Cwd/t/cwd.t lib/Cwd.pm + ! pod/perl586delta.pod ____________________________________________________________________________ -[ 23110] By: nicholas on 2004/07/14 23:36:17 +[ 23512] By: nicholas on 2004/11/17 14:50:18 Log: Integrate: - [ 23071] - Subject: [PATCH] prime_env_iter and zero-length values on VMS - From: "Craig A. Berry" <craigberry@mac.com> - Date: Thu, 08 Jul 2004 23:19:05 -0500 - Message-ID: <40EE1CB9.8030407@mac.com> + [ 23465] + Reformulate an error + (so the error message given by "perl -M" is a bit more + meaningful, as Jarkko pointed out) Branch: maint-5.8/perl - !> vms/vms.c + !> perl.c pod/perldiag.pod ____________________________________________________________________________ -[ 23087] By: nicholas on 2004/07/12 21:36:51 +[ 23511] By: nicholas on 2004/11/17 13:45:34 Log: Integrate: - [ 23076] - Perl_mode_from_discipline must update len. (else SEGV) - Diagnosis and patch from clkao - - [ 23083] - Perl_is_utf8_string(pTHX_ U8 *s, STRLEN len) - Can now handle the case - is_utf8_string(NULL,0) - again. - Why do we have code dup for Perl_is_utf8_string_loc() ? + [ 23506] + Subject: [PATCH] perl5db.pl POD cleanup + From: Autrijus Tang <autrijus@autrijus.org> + Date: Fri, 12 Nov 2004 12:41:33 +0800 + Message-ID: <20041112044133.GA92924@aut.dyndns.org> - [ 23084] - NI-S: IMHO utf8_upgrade is just changing representation not the value - so it has no business calling SvSETMAGIC. + [ 23508] + Fix a couple of typos. - [ 23085] - Bodge to make Tk work - like the UTF8 flag, the READONLY flag has too - many meanings. const const vs mutable in this case. + [ 23509] + PerlFAQ sync. Branch: maint-5.8/perl - ! sv.c - !> doio.c utf8.c + !> hv.c lib/perl5db.pl pod/perlfaq3.pod pod/perlfaq4.pod + !> pod/perlfaq6.pod pod/perlfaq7.pod utf8.c ____________________________________________________________________________ -[ 23086] By: nicholas on 2004/07/12 21:19:15 - Log: Disarm the release candidate +[ 23504] By: nicholas on 2004/11/16 21:29:19 + Log: Oops. They didn't want to get here. Pesky stowaways. Branch: maint-5.8/perl - ! patchlevel.h + - pod/perl590delta.pod pod/perl591delta.pod pod/perl592delta.pod ____________________________________________________________________________ -[ 23080] By: nicholas on 2004/07/11 16:07:49 - Log: Remove the Safe $VERSION FIXME. - Comment on the rearrangement of lib/unicore +[ 23503] By: nicholas on 2004/11/16 21:28:30 + Log: Integrate: + [ 23494] + Add some descriptive text from Larry to op.c on how optrees are built + + [ 23496] + Subject: [perl #32419] Spelling fixes for perl@23492 + Date: 12 Nov 2004 16:14:49 -0000 + From: Richard Soderberg (via RT) <perlbug-followup@perl.org> + Message-ID: <rt-3.0.11-32419-100173.13.0717895191322@perl.org> + + [ 23500] + Subject: [PATCH] s/hierachy/hierarchy/ + Date: Mon, 15 Nov 2004 15:59:14 -0700 + From: "Larry Shatzer Jr." <larrysh@cpan.org> + Message-ID: <20041115225913.GA22373@zippy.zyx.net> Branch: maint-5.8/perl - ! pod/perl585delta.pod + +> pod/perl590delta.pod pod/perl591delta.pod pod/perl592delta.pod + !> ext/B/B.pm ext/Time/HiRes/Makefile.PL op.c perlio.h + !> pod/perl573delta.pod pod/perl58delta.pod pod/perlapi.pod + !> pod/perlapio.pod pod/perldata.pod pod/perldebtut.pod + !> pod/perlipc.pod pod/perlport.pod pod/perlre.pod + !> pod/perlretut.pod pod/perlrun.pod pod/perlsub.pod + !> pod/perlthrtut.pod pod/perltodo.pod pod/perltooc.pod ____________________________________________________________________________ -[ 23070] By: nicholas on 2004/07/08 16:21:29 - Log: Need to copy the correct perldelta. - Also need to fix Makefile.SH to work out what to copy using pod.lst - (Spotted by Randal) +[ 23502] By: nicholas on 2004/11/16 14:20:15 + Log: Disarm the maint branch Branch: maint-5.8/perl - ! Makefile.SH + ! patchlevel.h ____________________________________________________________________________ -[ 23069] By: nicholas on 2004/07/08 13:53:43 - Log: This is RC2. Maybe this one will last longer. +[ 23493] By: nicholas on 2004/11/11 14:50:27 + Log: This is RC1 Branch: maint-5.8/perl ! patchlevel.h pod/perlhist.pod ____________________________________________________________________________ -[ 23068] By: nicholas on 2004/07/08 13:38:14 - Log: Update Changes - Branch: maint-5.8/perl - ! Changes patchlevel.h -____________________________________________________________________________ -[ 23067] By: nicholas on 2004/07/08 13:25:33 - Log: Rebuild toc. Resort MANIFEST - Branch: maint-5.8/perl - ! MANIFEST pod/perltoc.pod -____________________________________________________________________________ -[ 23066] By: nicholas on 2004/07/08 13:10:35 +[ 23488] By: nicholas on 2004/11/08 21:35:33 Log: Integrate: - [ 23062] - First stab at explaining that CLONE may get more parameters in future. - More eloquent rewording desired. Patches welcome. - - [ 23065] - Randal notes: - - "perldoc perldelta" still says 5.8.3 to 5.8.4, even though there - *is* a "perldoc perl583delta" properly. - - This is because perl584delta still thinks it's the perldelta + [ 23487] + No more late changes, dammit Branch: maint-5.8/perl - !> pod/perl584delta.pod pod/perlmod.pod + !> ext/B/t/optree_concise.t ____________________________________________________________________________ -[ 23064] By: nicholas on 2004/07/08 13:06:35 +[ 23486] By: nicholas on 2004/11/08 13:35:28 Log: Integrate: - [ 23063] - Make Perl_sv_utf8_upgrade_flags tolerate PL_sv_undef - as an argument. + [ 23485] + Subject: Re: optree tests and VMS progress (no really) + From: Yitzchak Scott-Thoennes <sthoenna@efn.org> + Date: Sun, 7 Nov 2004 23:24:15 -0800 + Message-ID: <20041108072415.GA3928@efn.org> Branch: maint-5.8/perl - !> sv.c + !> ext/B/t/OptreeCheck.pm ____________________________________________________________________________ -[ 23057] By: nicholas on 2004/07/06 13:00:52 - Log: This is RC1 +[ 23484] By: nicholas on 2004/11/07 13:53:14 + Log: Integrate: + [ 23481] + Subject: Re: optree tests and VMS progress (no really) + From: Jim Cromie <jim.cromie@gmail.com> + Message-ID: <cfe85dfa041105235723398fe2@mail.gmail.com> + Date: Sat, 6 Nov 2004 00:57:13 -0700 Branch: maint-5.8/perl - ! patchlevel.h pod/perlhist.pod + !> ext/B/t/OptreeCheck.pm ext/B/t/optree_check.t + !> ext/B/t/optree_concise.t ____________________________________________________________________________ -[ 23056] By: nicholas on 2004/07/06 12:45:46 - Log: Update Changes +[ 23483] By: nicholas on 2004/11/07 13:18:19 + Log: Integrate: + [ 23482] + document regcomp.c/regexec.c's dual life under ext/re/ Branch: maint-5.8/perl - ! Changes patchlevel.h + !> regcomp.c regexec.c ____________________________________________________________________________ -[ 23055] By: nicholas on 2004/07/06 11:35:31 - Log: Cargo cult 5.8.5 upgrade +[ 23480] By: nicholas on 2004/11/05 22:48:41 + Log: Cargo cult 5.8.6 upgrade Branch: maint-5.8/perl ! Cross/config.sh-arm-linux META.yml NetWare/Makefile README.os2 - ! README.vms epoc/createpkg.pl ext/List/Util/t/lln.t - ! patchlevel.h plan9/config.plan9 pod/perl585delta.pod - ! vos/build.cm vos/config.alpha.def vos/config.alpha.h - ! vos/config.ga.def vos/config.ga.h vos/install_perl.cm - ! win32/Makefile win32/config_H.bc win32/config_H.gc - ! win32/config_H.vc win32/config_H.vc64 win32/makefile.mk - ! wince/Makefile.ce + ! README.vms epoc/createpkg.pl patchlevel.h plan9/config.plan9 + ! pod/perl585delta.pod vos/build.cm vos/config.alpha.def + ! vos/config.alpha.h vos/config.ga.def vos/config.ga.h + ! vos/install_perl.cm win32/Makefile win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc win32/config_H.vc64 + ! win32/makefile.mk wince/Makefile.ce ____________________________________________________________________________ -[ 23054] By: nicholas on 2004/07/06 09:54:16 - Log: Another tweak +[ 23479] By: nicholas on 2004/11/05 22:01:13 + Log: Update perldelta Branch: maint-5.8/perl - ! pod/perl585delta.pod + ! pod/perl586delta.pod ____________________________________________________________________________ -[ 23053] By: nicholas on 2004/07/06 09:52:45 - Log: Improvements suggested by Jarkko +[ 23478] By: nicholas on 2004/11/05 21:24:11 + Log: Update Changes Branch: maint-5.8/perl - ! pod/perl585delta.pod + ! Changes patchlevel.h ____________________________________________________________________________ -[ 23050] By: nicholas on 2004/07/06 09:13:11 - Log: Fixup change 22979 in the ChangeLog *properly* (so that tools parse - it) +[ 23477] By: nicholas on 2004/11/05 21:03:42 + Log: Integrate: + [ 23475] + Subject: Re: Buidling stable.tar.gz on Unix as non-root [PATCH] + Date: Fri, 5 Nov 2004 10:36:57 -0500 (EST) + From: Andy Dougherty <doughera@lafayette.edu> + Message-ID: <Pine.SOL.4.58.0411051035020.15217@maxwell.phys.lafayette.edu> Branch: maint-5.8/perl - ! Changes + !> INSTALL ____________________________________________________________________________ -[ 23049] By: nicholas on 2004/07/05 17:46:57 - Log: Back out 22997 as it causes Net::DNS to spin forever in 05-rr-txt.t +[ 23476] By: nicholas on 2004/11/05 20:18:51 + Log: Integrate: + [ 23423] + Small updates to the web addresses for Perl, noticed by Robert Spier + + [ 23466] + FAQ sync Branch: maint-5.8/perl - ! lib/Text/ParseWords.pm lib/Text/ParseWords.t + !> pod/perl.pod pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod + !> pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod + !> pod/perlfaq6.pod pod/perlfaq7.pod pod/perlfaq8.pod + !> pod/perlfaq9.pod ____________________________________________________________________________ -[ 23045] By: nicholas on 2004/07/05 15:13:40 - Log: Change 23035 wasn't meant to integrate t/op/threads.t to maint +[ 23464] By: nicholas on 2004/11/01 18:20:33 + Log: Subject: Re: [patches] optree_* tests unexpectedly succeeding. + maint-only patch + From: Jim Cromie <jcromie@divsol.com> + Message-ID: <417EB697.9020301@divsol.com> + Date: Tue, 26 Oct 2004 14:41:59 -0600 Branch: maint-5.8/perl - - t/op/threads.t + ! ext/B/t/optree_check.t ____________________________________________________________________________ -[ 23044] By: nicholas on 2004/07/05 15:00:22 - Log: I missed the libnet upgrade. I almost missed Steve Hay reminding me of - this. +[ 23463] By: nicholas on 2004/11/01 15:28:24 + Log: Integrate: + [ 23444] + Skip tests if Devel::Peek not built Branch: maint-5.8/perl - ! pod/perl585delta.pod + !> ext/threads/shared/t/sv_refs.t ext/threads/t/end.t + !> ext/threads/t/join.t lib/base/t/fields-base.t ____________________________________________________________________________ -[ 23043] By: nicholas on 2004/07/05 14:58:20 - Log: Things noticed by Ronald J Kimball and Steve Hay +[ 23462] By: nicholas on 2004/11/01 14:51:33 + Log: Integrate: + [ 23445] + Set the IV values for PL_sv_yes and PL_sv_no at initialisation time. Branch: maint-5.8/perl - ! pod/perl585delta.pod + !> perl.c sv.c ____________________________________________________________________________ -[ 23041] By: nicholas on 2004/07/05 13:15:04 +[ 23461] By: nicholas on 2004/11/01 14:36:03 Log: Integrate: - [ 23029] - Subject: [PATCH Cwd 2.18] _vms_abs_path on non-directories - From: "Craig A. Berry" <craigberry@mac.com> - Message-ID: <40E704AA.4090801@mac.com> - Date: Sat, 03 Jul 2004 14:10:34 -0500 + [ 23440] + Assimilate I18N::LangTags 0.35 + + [ 23442] + Oops. Forgot to add the new test in I18N::LangTags 0.35 + + [ 23443] + Assimilate PathTools 3.01 (File::Spec and Cwd) Branch: maint-5.8/perl - !> ext/Cwd/t/cwd.t lib/Cwd.pm + +> lib/I18N/LangTags/t/20_locales.t + !> MANIFEST ext/Cwd/t/cwd.t lib/Cwd.pm lib/File/Spec.pm + !> lib/File/Spec/VMS.pm lib/I18N/LangTags.pm + !> lib/I18N/LangTags/ChangeLog lib/I18N/LangTags/List.pm + !> lib/I18N/LangTags/README ____________________________________________________________________________ -[ 23039] By: nicholas on 2004/07/04 21:32:40 +[ 23460] By: nicholas on 2004/11/01 14:16:33 Log: Integrate: - [ 23022] - The microperl config didn't know about usemallocwrap yet. - - [ 23027] - More microperl tweaks. + [ 23439] + Subject: [PATCH] Temporary fix for usemallocwrap problems on IRIX (was Re: usemallocwrap problems on IRIX (was Re: Problem and question)) + Date: Sun, 31 Oct 2004 04:01:42 -0500 + From: Ed Allen Smith <easmith@beatrice.rutgers.edu> + Message-Id: <mid+200410310901.i9V91g1Y519894@dogberry.rutgers.edu> Branch: maint-5.8/perl - !> Makefile.micro README.micro uconfig.h uconfig.sh + !> hints/irix_6.sh ____________________________________________________________________________ -[ 23038] By: nicholas on 2004/07/04 21:22:18 +[ 23459] By: nicholas on 2004/11/01 14:04:39 Log: Integrate: - [ 23019] - Bump version numbers + [ 23431] + Subject: [PATCH] 36 additional tests for B + From: Steve Peters <steve@fisharerojo.org> + Date: Fri, 29 Oct 2004 00:53:22 -0500 + Message-Id: <200410290053.22947.steve@fisharerojo.org> - [ 23025] - Bump version number of Safe for CPAN release + [ 23446] + Subject: [patches] optree_* tests unexpectedly succeeding. + maint-only patch + From: Jim Cromie <jim.cromie@gmail.com> + Message-ID: <cfe85dfa04102515365f11ef10@mail.gmail.com> + Date: Mon, 25 Oct 2004 16:36:40 -0600 Branch: maint-5.8/perl - !> ext/File/Glob/Glob.pm ext/Opcode/Safe.pm - !> ext/XS/APItest/APItest.pm ext/threads/threads.pm lib/Carp.pm - !> lib/File/Copy.pm lib/Text/ParseWords.pm lib/Text/Wrap.pm - !> lib/autouse.pm lib/charnames.pm lib/diagnostics.pm lib/utf8.pm + !> ext/B/t/b.t ext/B/t/optree_check.t ext/B/t/optree_varinit.t ____________________________________________________________________________ -[ 23037] By: nicholas on 2004/07/04 21:12:06 +[ 23458] By: nicholas on 2004/11/01 13:39:35 Log: Integrate: - [ 23010] - More caveats in B::Deparse's documentation - (suggested by Yves Orton) - - [ 23011] - Note that sv_2mortal isn't just "increase reference count by 1, and - mark that it needs a deferred recount" - - [ 23014] - Subject: [PATCH pod/perlop.pod] Documenting undefined behaviour of $i = $i ++. - From: Abigail <abigail@abigail.nl> - Date: Wed, 30 Jun 2004 12:00:21 +0200 - Message-ID: <20040630100021.GA23752@abigail.nl> - - [ 23026] - Maintainer change for Safe + [ 23424] + Fix [perl #32130] Errno.pm must not pass references to "prototype" Branch: maint-5.8/perl - !> Porting/Maintainers.pl ext/B/B/Deparse.pm pod/perlop.pod sv.c + !> ext/Errno/Errno_pm.PL ext/Errno/t/Errno.t ____________________________________________________________________________ -[ 23036] By: nicholas on 2004/07/04 20:59:30 +[ 23456] By: nicholas on 2004/11/01 13:06:23 Log: Integrate: - [ 22995] - Subject: [PATCH] regcomp.c, t/op/regmesg.t -- False range with \p and \P - From: Jeff 'japhy' Pinyan <japhy@perlmonk.org> - Date: Thu, 24 Jun 2004 16:42:54 -0400 (EDT) - Message-ID: <Pine.LNX.4.44.0406241636340.8774-200000@perlmonk.org> + [ 23438] + [perl #32033] Using foreach on threads::shared array crashes perl + The FETCH code for shared aggregate elements could leak a shared RV + address into a private SV. RVs are now handled specially, in the + same way that they already were for scalar shared magic. Branch: maint-5.8/perl - !> regcomp.c t/op/regmesg.t + !> ext/threads/shared/shared.xs ____________________________________________________________________________ -[ 23035] By: nicholas on 2004/07/04 20:49:10 +[ 23454] By: nicholas on 2004/11/01 12:38:48 Log: Integrate: - [ 22994] - More @INC test fixes + [ 23419] + Subject: [PATCH] Re: Devel::Peek: hash quality 125%? + From: Tels <perl_dummy@bloodgate.com> + Date: Sat, 23 Oct 2004 16:56:31 +0200 + Message-Id: <200410231656.40995@bloodgate.com> - [ 22998] - Correct detection of absent modules. Based on + [ 23420] + Subject: Re: [perl #31937] perlop: add basic =~ examples + From: Steve Peters <steve@fisharerojo.org> + Date: Sat, 23 Oct 2004 08:01:51 -0500 + Message-Id: <200410230801.51649.steve@fisharerojo.org> - Subject: [PATCH] Config{extensions} uses filesystem names as extensions - From: Andy Dougherty <doughera@lafayette.edu> - Message-ID: <Pine.SOL.4.58.0406241505530.14039@maxwell.phys.lafayette.edu> - Date: Thu, 24 Jun 2004 15:09:47 -0400 (EDT) + [ 23422] + Subject: [perl #30227] [PATCH]splain vs. -w + From: "Steve Peters via RT" <perlbug-followup@perl.org> + Date: 23 Oct 2004 13:55:41 -0000 + Message-ID: <rt-3.0.11-30227-98375.1.28465791111211@perl.org> + + [ 23432] + Document sv_magic() changes brought about by sv_magicext() - with improvements from Marcus Holland-Moritz + Change 14335 made sv_magic() a wrapper to a new sv_magicext(), + but didn't update the documentation for sv_magic() to reflect + the changed handling of the name/namlen arguments. - [ 23028] - /usr/bin/locale steadfastly delivers 8 bit output independent of - LC_ALL. So when perl's expecting utf8, things don't quite work right. - This has become visible since fix 22842 + Also correct a couple of typos, and mention sv_magicext() in + perlguts. Branch: maint-5.8/perl - +> t/op/threads.t - !> ext/Devel/PPPort/t/test.t ext/PerlIO/t/scalar.t - !> ext/PerlIO/t/via.t ext/threads/shared/t/disabled.t lib/DB.t - !> lib/Dumpvalue.t lib/PerlIO/via/t/QuotedPrint.t - !> lib/Tie/RefHash.t lib/autouse.t lib/dumpvar.t lib/h2xs.t - !> lib/locale.t lib/overload.t t/io/crlf.t t/uni/chomp.t - !> t/uni/tr_7jis.t t/uni/tr_eucjp.t t/uni/tr_sjis.t - !> t/uni/tr_utf8.t + !> ext/Devel/Peek/Changes ext/Devel/Peek/Peek.pm + !> lib/diagnostics.pm pod/perlapi.pod pod/perlguts.pod + !> pod/perlop.pod sv.c ____________________________________________________________________________ -[ 23034] By: nicholas on 2004/07/04 20:23:50 +[ 23453] By: nicholas on 2004/11/01 12:17:44 Log: Integrate: - [ 22992] - Fix for: [perl #30442] Text::ParseWords does not handle backslashed newline inside quoted text - Use the suggested regex fix, plus some tests. + [ 23266] + [perl #31078] Fields package bug + An intermediate class with no fields messes up private fields + in the base class. - [ 22997] - Cleanup the main regex in Text::ParseWords and make the - parse_line() routine faster. Add a Unicode test case. + [ 23267] + I somehow managed to omit the base.pm change from #23266 Branch: maint-5.8/perl - !> lib/Text/ParseWords.pm lib/Text/ParseWords.t + !> lib/base.pm lib/base/t/fields-base.t +____________________________________________________________________________ +[ 23452] By: nicholas on 2004/11/01 10:24:35 + Log: Improvements and corrections as suggested by Ed Allen Smith, + Glenn Linderman, Yitzchak Scott-Thoennes and Steve Hay + Branch: maint-5.8/perl + ! pod/perl586delta.pod ____________________________________________________________________________ -[ 23033] By: nicholas on 2004/07/04 20:12:51 +[ 23451] By: nicholas on 2004/10/31 18:46:53 + Log: First draft of 5.8.6's perldelta + Branch: maint-5.8/perl + ! pod/perl586delta.pod +____________________________________________________________________________ +[ 23447] By: nicholas on 2004/10/31 14:25:17 Log: Integrate: - [ 22990] - Fix for: [perl #2738] perl segfautls on input - The parser was incorrectly accepting <> as a subroutine prototype and - newATTRSUB didn't validate the proto argument before accessing op_sv. + [ 23365] + Fix [perl #31971] local $^D gives noise - [ 23006] - [perl #30509] use encoding and "eq" cause memory leak - Perl_sv_eq() was creating a temp and not always freeing it + (ish. Actually a rewrite to give binary compatibility) Branch: maint-5.8/perl - ! t/comp/parser.t - !> op.c pod/perldiag.pod sv.c toke.c + ! embed.fnc embed.h mg.c perl.c proto.h ____________________________________________________________________________ -[ 23032] By: nicholas on 2004/07/04 19:46:34 +[ 23430] By: nicholas on 2004/10/28 10:20:54 Log: Integrate: - [ 22942] - Upgrade to Locale::Maketext 1.09 + [ 23425] + Subject: [PATCH] lib/Carp.t improvements + From: "Craig A. Berry" <craigberry@mac.com> + Date: Tue, 26 Oct 2004 23:32:25 -0500 + Message-Id: <417F24D9.1000904@mac.com> Branch: maint-5.8/perl - +> lib/Locale/Maketext/t/01_about_verbose.t - +> lib/Locale/Maketext/t/10_make.t lib/Locale/Maketext/t/20_get.t - +> lib/Locale/Maketext/t/40_super.t - +> lib/Locale/Maketext/t/50_super.t - +> lib/Locale/Maketext/t/60_super.t - +> lib/Locale/Maketext/t/90_utf8.t - - lib/Locale/Maketext/t/00about.t lib/Locale/Maketext/t/01make.t - - lib/Locale/Maketext/t/02get.t lib/Locale/Maketext/t/03http.t - - lib/Locale/Maketext/t/04super.t - - lib/Locale/Maketext/t/05super.t - - lib/Locale/Maketext/t/06super.t lib/Locale/Maketext/t/90utf8.t - !> MANIFEST lib/Locale/Maketext.pm lib/Locale/Maketext/ChangeLog - !> lib/Locale/Maketext/README + !> lib/Carp.t ____________________________________________________________________________ -[ 23031] By: nicholas on 2004/07/04 19:35:48 +[ 23429] By: nicholas on 2004/10/28 10:07:49 Log: Integrate: - [ 22946] - Upgrade to I18N::LangTags 0.31. + [ 23418] + [perl #32039] Chained goto &sub drops data too early. - [ 22964] - Upgrade to I18N::LangTags 0.32 + Change 22373 to stop a memory leak in goto &foo intead caused + the elements of @_ to be freed too early. This revised fix + just transfers the reifiedness of the old @_ to the new @_ - [ 23001] - Stop 80_all_env.t failing when LC_ALL is set - - [ 23024] - Upgrade to I18N::LangTags 0.33 - - (this would have all been part of the previous change but - http://www.google.com/search?btnI=again&q=perforce+fails+bah ) + [ 23426] + include flags and refcount in the list of leaked scalars Branch: maint-5.8/perl - !> lib/I18N/LangTags.pm lib/I18N/LangTags/ChangeLog - !> lib/I18N/LangTags/Detect.pm lib/I18N/LangTags/t/10_http.t - !> lib/I18N/LangTags/t/80_all_env.t + !> perl.c pp_ctl.c t/op/goto.t ____________________________________________________________________________ -[ 23030] By: nicholas on 2004/07/04 19:22:15 +[ 23428] By: nicholas on 2004/10/28 09:26:16 Log: Integrate: - [ 22941] - Upgrade to I18N::LangTags 0.30. + [ 23416] + Subject: [PATCH] ext/IO/IO.xs: fix blocking on sparc linux + Message-ID: <20041022033033.GA12362@londo.c47.org> + From: Brendan O'Dea <bod@debian.org> + Date: Fri, 22 Oct 2004 13:30:33 +1000 Branch: maint-5.8/perl - +> lib/I18N/LangTags/Detect.pm - +> lib/I18N/LangTags/t/01_about_verbose.t - +> lib/I18N/LangTags/t/05_main.t lib/I18N/LangTags/t/07_listy.t - +> lib/I18N/LangTags/t/10_http.t lib/I18N/LangTags/t/50_super.t - +> lib/I18N/LangTags/t/55_supers_strict.t - +> lib/I18N/LangTags/t/80_all_env.t - - lib/I18N/LangTags/t/01test.t lib/I18N/LangTags/t/02decency.t - !> MANIFEST lib/I18N/LangTags.pm lib/I18N/LangTags/ChangeLog - !> lib/I18N/LangTags/List.pm + !> ext/IO/IO.xs ____________________________________________________________________________ -[ 23020] By: nicholas on 2004/07/01 13:35:17 +[ 23427] By: nicholas on 2004/10/28 09:10:57 Log: Integrate: - [ 23016] - Sync to libnet-1.19 + [ 23417] + Upgrade to Encode 2.07 + + [ 23421] + Upgrade to Encode 2.08. Branch: maint-5.8/perl - !> lib/Net/Changes.libnet lib/Net/Cmd.pm lib/Net/FTP.pm - !> lib/Net/POP3.pm lib/Net/SMTP.pm lib/Net/t/datasend.t + !> ext/Encode/AUTHORS ext/Encode/Changes ext/Encode/Encode.pm + !> ext/Encode/Encode.xs ext/Encode/META.yml + !> ext/Encode/Unicode/Unicode.pm ext/Encode/Unicode/Unicode.xs + !> ext/Encode/encoding.pm ext/Encode/lib/Encode/Encoding.pm + !> ext/Encode/t/Encode.t ext/Encode/t/fallback.t + !> ext/Encode/ucm/macArabic.ucm ext/Encode/ucm/macCentEuro.ucm + !> ext/Encode/ucm/macChinsimp.ucm ext/Encode/ucm/macChintrad.ucm + !> ext/Encode/ucm/macDingbats.ucm ext/Encode/ucm/macGreek.ucm + !> ext/Encode/ucm/macKorean.ucm ext/Encode/ucm/macROMnn.ucm + !> ext/Encode/ucm/macSymbol.ucm ext/Encode/ucm/macThai.ucm ____________________________________________________________________________ -[ 23017] By: nicholas on 2004/06/30 20:28:29 - Log: Back 22969 out of maint. (reinstate the "Tied variable freed while - still in use" error for the moment, as my change causes interesting - bugs under utf8 locales) +[ 23415] By: nicholas on 2004/10/22 18:01:45 + Log: Update Changes Branch: maint-5.8/perl - ! mg.c pod/perldiag.pod t/op/tie.t + ! Changes patchlevel.h ____________________________________________________________________________ -[ 23015] By: nicholas on 2004/06/30 12:17:35 +[ 23414] By: nicholas on 2004/10/22 17:48:44 Log: Integrate: - [ 23002] - Assimilate Locale-Codes-2.07 + [ 23410] + Subject: docpatch for perltie.pod + From: David Cantrell <david@cantrell.org.uk> + Date: Thu, 21 Oct 2004 12:21:52 +0100 + Message-ID: <20041021112151.GA22862@bytemark.barnyard.co.uk> Branch: maint-5.8/perl - !> lib/Locale/Codes/ChangeLog lib/Locale/Codes/README - !> lib/Locale/Codes/t/all.t lib/Locale/Codes/t/constants.t - !> lib/Locale/Codes/t/country.t lib/Locale/Codes/t/currency.t - !> lib/Locale/Codes/t/uk.t lib/Locale/Constants.pm - !> lib/Locale/Constants.pod lib/Locale/Country.pm - !> lib/Locale/Country.pod lib/Locale/Currency.pm - !> lib/Locale/Currency.pod lib/Locale/Language.pm - !> lib/Locale/Language.pod lib/Locale/Script.pm - !> lib/Locale/Script.pod + !> pod/perltie.pod ____________________________________________________________________________ -[ 23013] By: nicholas on 2004/06/30 11:25:27 +[ 23413] By: nicholas on 2004/10/22 17:47:25 Log: Integrate: - [ 22988] - Upgrade to Cwd 2.17_03 + [ 23372] + Implement a new -dt command-line flag, to enable threads under the + debugger (bug #31666). - [ 22991] - Upgrade to Cwd 2.18 - (with local changes to cwd.t, to adapt it to the core) + Subject: RE: [PATCH] debugger handles threads [perl #31666] + From: <richard.foley@ubs.com> + Date: Wed, 13 Oct 2004 13:01:18 +0200 + Message-ID: <B374141B0A424D4F9CF143CC51B3ADD903FB9E12@NZURC900PEX1.ubsgs.ubsgroup.net> - [ 22993] - Fix the Cwd tests for the core. + Subject: Re: [PATCH] debugger handles threads [perl #31666] + From: Yitzchak Scott-Thoennes <sthoenna@efn.org> + Date: Wed, 13 Oct 2004 02:49:58 -0700 + Message-ID: <20041013094957.GA17184@efn.org> + Branch: maint-5.8/perl + !> lib/perl5db.pl perl.c pod/perlrun.pod +____________________________________________________________________________ +[ 23412] By: nicholas on 2004/10/22 15:51:06 + Log: Back out changes 23347 and 23349 for now, as they cause URI to fail + regression tests. (Integrated with change 23391). + It's not clear to me whether the regression tests are buggy, or this + change, or something else which this change now exposes. + Branch: maint-5.8/perl + ! lib/overload.pm lib/overload.t +____________________________________________________________________________ +[ 23411] By: nicholas on 2004/10/22 15:26:39 + Log: Ooops. I forgot to move Changes to Changes5.8.5. Split things properly + Branch: maint-5.8/perl + +> Changes5.8.5 + ! Changes MANIFEST +____________________________________________________________________________ +[ 23409] By: nicholas on 2004/10/21 15:49:06 + Log: Update Changes + Branch: maint-5.8/perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 23408] By: nicholas on 2004/10/21 15:42:32 + Log: Rebuild table of contents and re-sort MANIFEST Branch: maint-5.8/perl - !> ext/Cwd/Changes ext/Cwd/Cwd.xs ext/Cwd/t/cwd.t - !> ext/Cwd/t/taint.t lib/Cwd.pm + ! MANIFEST pod/perltoc.pod +____________________________________________________________________________ +[ 23407] By: nicholas on 2004/10/21 15:37:52 + Log: Re-run regen.pl + Branch: maint-5.8/perl + ! pod/perlapi.pod pod/perlintern.pod +____________________________________________________________________________ +[ 23406] By: nicholas on 2004/10/21 15:18:42 + Log: Integrate: + [ 23393] + Ensure that PVA.pl returns a true value. + + [ 23394] + Remove opmini.c when cleaning up. + Branch: maint-5.8/perl + !> Makefile.SH lib/unicore/mktables ____________________________________________________________________________ -[ 23012] By: nicholas on 2004/06/30 11:11:43 +[ 23405] By: nicholas on 2004/10/21 15:08:19 Log: Integrate: - [ 22935] - Assert SvTYPE is at least PGMV whenever accessing SvSTASH - (the Storable.xs part) + [ 22741] + Include variable names in "Use of uninitialized value" warnings + (just for lib/Math/BigInt/t/mbimbf.inc) - [ 22943] - Storable should cope if the string to thaw happens to be utf8 encoded - And anything with bytes >=256 is corrupt - [ 22944] - Change 22516 forgot to add make_overload.pl to generate test data - (submitted from the pub via wireless, bluetooth and then GPRS out - to the Internet) + [ 23216] + Subject: [PATCH] pre Math::BigInt v1.72 + From: Tels <perl_dummy@bloodgate.com> + Date: Fri, 13 Aug 2004 14:02:50 +0200 + Message-Id: <200408131402.52270@bloodgate.com> - [ 22968] - Subject: [PATCH] Storable signedness nit - From: "Craig A. Berry" <craigberry@mac.com> - Message-ID: <40D3AAC7.6030407@mac.com> - Date: Fri, 18 Jun 2004 21:53:59 -0500 - Branch: maint-5.8/perl - +> ext/Storable/t/make_overload.pl - !> MANIFEST ext/Storable/ChangeLog ext/Storable/README - !> ext/Storable/Storable.pm ext/Storable/Storable.xs - !> ext/Storable/t/utf8.t -____________________________________________________________________________ -[ 23009] By: nicholas on 2004/06/29 11:09:36 - Log: Integrate: - [ 22996] - Subject: [perl #30450] perl 5.8.4: enhancement to hints/solaris_2.sh - From: Nicholas Gianniotis (via RT) <perlbug-followup@perl.org> - Date: 25 Jun 2004 09:39:51 -0000 - Message-ID: <rt-3.0.9-30450-91340.10.3279898804255@perl.org> - and - From: Andy Dougherty <doughera@lafayette.edu> - Date: Fri, 25 Jun 2004 11:30:11 -0400 (EDT) - Message-ID: <Pine.SOL.4.58.0406251113420.15961@maxwell.phys.lafayette.edu> + [ 23359] + Subject: Patch: BigInt v1.73 (pre-release) + From: Tels <perl_dummy@bloodgate.com> + Date: Sun, 10 Oct 2004 22:36:03 +0200 + Message-Id: <200410102236.03637@bloodgate.com> - [ 23007] - HP-UX 10.20 still *needs* -Ae for HP C-ANSI-C to be ANSI - 11.00 and on are ANSI by default for /opt/ansic/bin - Error was introduced by #22975 in re-enabling 10.01 + [ 23396] + Subject: [PATCH] Math::BigInt v1.73 final + From: Tels <perl_dummy@bloodgate.com> + Date: Wed, 20 Oct 2004 21:06:40 +0200 + Message-Id: <200410202106.41840@bloodgate.com> + + Subject: [PATCH] Math::BigRat v0.13 (pre-release) + From: Tels <tels@bloodgate.com> + Date: Wed, 20 Oct 2004 22:03:55 +0200 + Message-Id: <200410202203.56063@bloodgate.com> Branch: maint-5.8/perl - !> hints/hpux.sh hints/solaris_2.sh + !> lib/Math/BigFloat.pm lib/Math/BigInt.pm + !> lib/Math/BigInt/Calc.pm lib/Math/BigInt/t/bare_mbf.t + !> lib/Math/BigInt/t/bare_mbi.t lib/Math/BigInt/t/bigfltpm.inc + !> lib/Math/BigInt/t/bigfltpm.t lib/Math/BigInt/t/bigintpm.inc + !> lib/Math/BigInt/t/bigintpm.t lib/Math/BigInt/t/mbimbf.inc + !> lib/Math/BigInt/t/sub_mbf.t lib/Math/BigInt/t/sub_mbi.t + !> lib/Math/BigInt/t/upgrade.inc lib/Math/BigInt/t/upgrade.t + !> lib/Math/BigInt/t/with_sub.t lib/Math/BigRat.pm + !> lib/Math/BigRat/t/big_ap.t lib/Math/BigRat/t/bigrat.t + !> lib/Math/BigRat/t/bigratpm.inc lib/Math/BigRat/t/bigratpm.t + !> lib/Math/BigRat/t/bigratup.t ____________________________________________________________________________ -[ 23005] By: nicholas on 2004/06/28 17:03:14 - Log: Draft 1 of perl585delta. +[ 23404] By: nicholas on 2004/10/21 13:53:01 + Log: Integrate: + [ 23052] + A tool to check the AUTHORS file + + [ 23371] + Make autodoc.pl write its output with UNIX style EOL's. + + This saves the Win32 committer(s?) having to dos2unix the files + before committing. Maybe Perforce's "LineEnd: share" suffices + anyway, but there's no harm in playing safe. Branch: maint-5.8/perl - ! pod/perl585delta.pod + +> Porting/checkAUTHORS.pl + !> MANIFEST autodoc.pl ____________________________________________________________________________ -[ 23004] By: rgs on 2004/06/28 16:29:21 - Log: Document h2ph changes in perldelta +[ 23403] By: nicholas on 2004/10/21 13:32:54 + Log: Integrate: + [ 23360] + Subject: [PATCH-for-23358] enable statically linked extensions for Win32 + From: Vadim Konovalov <konovalo@mail.wplus.net> + Date: Mon, 11 Oct 2004 22:57:00 +0400 + Message-ID: <80173417046.20041011225700@vkonovalov.ru> + + [ 23363] + Subject: [PATCH@23361] RE: [PATCH-for-23358] enable statically linked exte nsions for Win32 + From: "Konovalov, Vadim" <vkonovalov@spb.lucent.com> + Date: Wed, 13 Oct 2004 09:45:31 +0400 + Message-ID: <7DD1BE2C50259746ABB8683672D2089E08133C@itotest-1.spb.lucent.com> Branch: maint-5.8/perl - ! pod/perl585delta.pod + !> makedef.pl win32/Makefile win32/buildext.pl win32/dl_win32.xs + !> win32/makefile.mk win32/perllib.c win32/sync_ext.pl ____________________________________________________________________________ -[ 23003] By: nicholas on 2004/06/28 12:16:52 - Log: Correct the changelog entry for 22979 +[ 23402] By: nicholas on 2004/10/21 13:03:35 + Log: Integrate: + [ 23353] + A new machine type, some reformatting, some reorganization + and a bit of additional info on Sleepycat's db. + + [ 23364] + A few fixes in the list of -D debugging flags + + [ 23392] + Subject: [PATCH perl.c pod/perl.pod pod/perlfaq2.pod] + Rephrase "Perl Home Page" References + From: chromatic <chromatic@wgz.org> + Date: Tue, 19 Oct 2004 22:52:19 -0700 + Message-Id: <1098251539.20976.53.camel@localhost> Branch: maint-5.8/perl - ! Changes + !> AUTHORS README.hpux perl.c pod/perl.pod pod/perlfaq2.pod + !> pod/perlrun.pod ____________________________________________________________________________ -[ 23000] By: nicholas on 2004/06/27 15:19:21 - Log: Update Changes. Almost time for 5.8.5 +[ 23401] By: nicholas on 2004/10/21 12:50:53 + Log: Integrate: + [ 23354] + Make AIX 5 + gcc work in 64bitall Branch: maint-5.8/perl - ! Changes patchlevel.h + !> hints/aix.sh ____________________________________________________________________________ -[ 22999] By: nicholas on 2004/06/27 12:18:13 +[ 23400] By: nicholas on 2004/10/21 11:43:53 Log: Integrate: - [ 21936] - fix [perl #24660], [perl #24663]. + [ 23351] + Make the perl interpreter more tolerant of UTF-16-encoded script + (patch by Jarkko Hietaniemi) + + [ 23352] + Briefly document the test.utf16 make target. - [ 22106] - still problems with backreferences + reverse cloning - after #21936 - the weak reference may live on the pad. + [ 23362] + Minor tweaks for the test.utf16 target, by Jarkko Branch: maint-5.8/perl - !> mg.c sv.c + !> Makefile.SH pod/perlhack.pod t/TEST toke.c utf8.c ____________________________________________________________________________ -[ 22989] By: nicholas on 2004/06/24 15:09:34 +[ 23399] By: nicholas on 2004/10/21 11:13:27 Log: Integrate: - [ 22872] - First step to generating Unicode files for the regexp engine at build - time - targets in the Makefile - - [ 22873] - Convert to using File::Spec, so that we can build Unicode files - on all platforms + [ 23348] + Subject: [PATCH-for-23341] dynaloader improvements and cleanup + From: Vadim Konovalov <vadim@vkonovalov.ru> + Date: Sun, 3 Oct 2004 22:10:06 +0400 + Message-ID: <138-1837306906.20041003221006@vkonovalov.ru> - [ 22879] - Run mktables as part of the build process. - Don't ship any of the files that it generates in lib/unicore - - [ 22880] - Don't need to require utf8_pva.pl at top of file + [ 23361] + Subject: [perl #31843] warnings::warn($obj,...) fails when $obj overloads "" + From: kaminsky@math.huji.ac.il (via RT) <perlbug-followup@perl.org> + Date: 5 Oct 2004 09:52:07 -0000 + Message-ID: <rt-3.0.11-31843-97358.2.89612012687236@perl.org> + (with tweaks) + Branch: maint-5.8/perl + !> ext/DynaLoader/DynaLoader_pm.PL lib/warnings.pm warnings.pl +____________________________________________________________________________ +[ 23398] By: nicholas on 2004/10/21 10:54:14 + Log: Integrate: + [ 23343] + Subject: [PATCH] make t/uni/class.t pass on VMS + From: "Craig A. Berry" <craigberry@mac.com> + Date: Fri, 01 Oct 2004 12:57:55 -0500 + Message-ID: <415D9AA3.1000908@mac.com> - [ 22881] - replace the run time code in lib/utf8_pva.pl with data generated - at build by mktables, stored in lib/unicore/PVA.pl + [ 23346] + Subject: [PATCH] vms/t/filespec.t tweak + From: "Craig A. Berry" <craigberry@mac.com> + Date: Fri, 01 Oct 2004 13:18:03 -0500 + Message-ID: <415D9F5B.5040306@mac.com> - [ 22887] - Subject: Re: Smoke [5.9.2] 22881 FAIL(M) MSWin32 WinXP/.Net SP1 (x86/1 cpu) - From: Steve Hay <steve.hay@uk.radan.com> - Date: Tue, 01 Jun 2004 15:30:37 +0100 - Message-ID: <40BC930D.90701@uk.radan.com> + [ 23358] + Subject: [PATCH] add the 'test_harness' target to vms "makefile" + From: Abe Timmerman <abe@ztreet.demon.nl> + Date: Sat, 9 Oct 2004 18:13:38 +0200 + Message-Id: <200410091813.38673.abe@ztreet.demon.nl> - [ 22899] - Workaround a dmake oddity. - Subject: Re: Smoke [5.9.2] 22881 FAIL(M) MSWin32 WinXP/.Net SP1 (x86/1 cpu) - From: Steve Hay <steve.hay@uk.radan.com> - Date: Thu, 03 Jun 2004 12:16:13 +0100 - Message-ID: <40BF087D.8030005@uk.radan.com> + [ 23367] + Subject: [PATCH] Re: [NOT OK] 23353 OpenVMS 7.2 VAX + From: "Craig A. Berry" <craigberry@mac.com> + Date: Thu, 14 Oct 2004 10:09:41 -0500 + Message-ID: <416E96B5.5020100@mac.com> - [ 22924] - Subject: Change 22872 breaks shared miniperl invocation - From: Alexey Tourbin <at@altlinux.ru> - Date: Fri, 4 Jun 2004 13:24:17 +0400 - Message-ID: <20040604092417.GA13447@solemn.turbinal.org> + [ 23377] + Subject: [PATCH] test_harness tweak for VMS + From: "Craig A. Berry" <craigberry@mac.com> + Date: Sat, 16 Oct 2004 12:15:02 -0500 + Message-Id: <41715716.5000108@mac.com> + Branch: maint-5.8/perl + !> ext/Devel/PPPort/parts/inc/ppphtest + !> ext/Devel/PPPort/t/ppphtest.t t/harness t/uni/class.t + !> vms/descrip_mms.template vms/ext/filespec.t vms/test.com +____________________________________________________________________________ +[ 23397] By: nicholas on 2004/10/21 10:30:49 + Log: Integrate: + [ 23350] + Subject: [perl #31697] [PATCH] B::Showlex::newlex enhancement and pod + From: Jim Cromie (via RT) <perlbug-followup@perl.org> + Date: 23 Sep 2004 21:45:42 -0000 + Message-ID: <rt-3.0.11-31697-96840.0.810265136907162@perl.org> + (with doc nits) - [ 22961] - 'make test' without preceeding 'make' fails. - Change #22872 added a target to run mktables, but this was - skipped if 'make test' was run first, causing the build of - Unicode::Normalize to fail. + [ 23356] + Hack to make -Dusethreads -Uuseithreads -Uuse5005threads pass all tests - [ 22963] - make mktables always update modifed time to play better with make + [ 23395] + Need to skip optree walking tests if perlio not built Branch: maint-5.8/perl - - (delete 420 files) - !> MANIFEST Makefile.SH lib/unicore/mktables lib/utf8_heavy.pl - !> vms/descrip_mms.template win32/Makefile win32/makefile.mk + !> ext/B/B/Concise.pm ext/B/B/Showlex.pm ext/B/t/OptreeCheck.pm + !> ext/B/t/f_map.t ext/B/t/f_sort.t ext/B/t/showlex.t ____________________________________________________________________________ -[ 22987] By: nicholas on 2004/06/23 15:54:27 +[ 23391] By: nicholas on 2004/10/19 20:10:52 Log: Integrate: - [ 22960] - When expecting an error, it's best to check the text you got, rather - than blindly assuming that it's correct. + [ 22926] + Subject: Re: [perl #30197] perlbug AutoReply: Data::Dumper does not indent the deparsed code properly + From: Mathieu Arnold <m@absolight.fr> + Date: Thu, 10 Jun 2004 16:43:58 +0200 + Message-ID: <34D483170C7F84E0DFBE442B@andromede.in.reaumur.net> + (with a test adjustment) + + [ 23347] + Subject: [PATCH perl-current] Re: [perl #31793] Data::Dumper: Useqq interacts badly with overloading + From: Rick Delaney <rick@bort.ca> + Date: Sat, 2 Oct 2004 01:04:49 -0400 + Message-ID: <20041002050448.GB5059@biff.bort.ca> + + [ 23349] + Increment $overload::VERSION after change #23347 Branch: maint-5.8/perl - !> t/op/write.t + !> ext/B/B/Concise.pm ext/Data/Dumper/Dumper.pm + !> ext/Data/Dumper/t/dumper.t lib/overload.pm lib/overload.t ____________________________________________________________________________ -[ 22986] By: nicholas on 2004/06/23 15:30:36 +[ 23390] By: nicholas on 2004/10/19 19:35:22 Log: Integrate: - [ 22928] - t/comp/utf.t failed when configuring with -Dnoextensions=Encode + [ 23331] + Subject: Re: [perl #31586] utime does not reach expectations [PATCH] + From: LAUN Wolfgang <wolfgang.laun@alcatel.at> + Date: Fri, 17 Sep 2004 14:01:11 +0200 + Message-Id: <DF27CDCBD2581D4B88431901094E4B4D02B0C88B@attmsx1.aut.alcatel.at> - [ 22947] - Need to skip test 7 if perl built without the PerlIO::scalar extension + Clarify the effect of utime when the file isn't owned by the user - [ 22948] - Can't test the B modules if we didn't build 'em + [ 23332] + Document that $ENV{PATH} may not contain relative directories under -T - [ 22949] - Unicode::UCD uses Storable, so we can't test if Storable isn't built. + [ 23333] + Remove a couple of C<> to avoid confusing double quotes in text + rendering. [perl #31678] - [ 22950] - D'oh. Don't turn on warnings on the #! line without actually testing - the full code in case it warns. + [ 23338] + Spelling correction spotted by Greg McCarroll - [ 22951] - If we don't build B, we should skip all its tests. + [ 23341] + Subject: [patch] Sys::Syslog POD - $Sys::Syslog::host + From: "Jay Hannah" <jhannah@omnihotels.com> + Date: Wed, 15 Sep 2004 14:51:42 -0500 + Message-ID: <002001c49b5d$6d0d79c0$4722000a@omarests2> - [ 22952] - Skip re tests if re not built. + [ 23345] + More caveats on the non-portability of stat(), suggested by + Stas Bekman. - [ 22953] - Skip test if Devel::PPPort not built + [ 23368] + Document sv_vcatpvf, sv_vsetpvf, sv_vcatpvf_mg and sv_vsetpvf_mg. - [ 22954] - Skip test if perl configured without threads::shared + These are already in the API supported by Devel::PPPort, and are + often more useful than sv_vcatpvfn and sv_vsetpvfn which were + already documented. - [ 22955] - Not ideal, but skip all of IO's tests if Socket is not built. + [ 23369] + Doc nit to Data::Dumper, suggested by Peter Kay. + + [ 23378] + Add a missing warning categorisation in perldiag. + + [ 23379] + Fix a typo. + + [ 23382] + Subject: [PATCH] perlfaq2.pod (add a book) + From: <richard.foley@ubs.com> + Date: Tue, 19 Oct 2004 07:29:31 +0200 + Message-ID: <B374141B0A424D4F9CF143CC51B3ADD903FB9E3A@NZURC900PEX1.ubsgs.ubsgroup.net> + + [ 23383] + More Data::Dumper docs nits, fix the previous one, + suggested by Yves Orton. + Branch: maint-5.8/perl + !> README.epoc embed.fnc ext/Data/Dumper/Dumper.pm + !> ext/Sys/Syslog/Syslog.pm pod/perlapi.pod pod/perldiag.pod + !> pod/perlfaq2.pod pod/perlfunc.pod pod/perlop.pod + !> pod/perlsec.pod sv.c utils/c2ph.PL +____________________________________________________________________________ +[ 23389] By: nicholas on 2004/10/19 19:16:21 + Log: Integrate: + [ 23326] + Subject: [PATCH] encoding and open pragmas + From: Jarkko Hietaniemi <jhi@iki.fi> + Date: Mon, 16 Aug 2004 22:27:00 +0300 + Message-ID: <41210A84.6060506@iki.fi> - [ 22956] - Skip tests when PerlIO::scalar and PerlIO::via aren't built + Subject: Re: [PATCH] encoding and open pragmas + From: Jarkko Hietaniemi <jhi@iki.fi> + Date: Tue, 17 Aug 2004 11:22:58 +0300 (EEST) + Message-Id: <200408170822.i7H8MwUU016793@vipunen.hut.fi> - [ 22957] - Also needs skipping if PerlIO::via not built + [ 23334] + Typo fix. + Subject: [PATCH] Re: Smoke [5.9.2] 23330 FAIL(X) hp-ux 11.11/64 (PA-2.0/64/2 cpu) + From: Rafael Garcia-Suarez <rgarciasuarez@mandrakesoft.com> + Date: Wed, 22 Sep 2004 11:20:53 +0200 + Message-ID: <20040922112053.686562b6@valis.local> - [ 22958] - This needs POSIX, so skip if no POSIX + [ 23355] + Restore runtime loading of Encode and Encode-related modules, so that + open.pm will work when the Encode extension isn't build. - [ 22959] - Case insensitive file systems are bad, m'kay + [ 23380] + Upgrade to Encode 2.04. - [ 22965] - Skip test if Devel::PPPort is not built. - Probably should fix h2xs to work without it. + [ 23381] + Re-apply the encoding.pm part of: - [ 22966] - Skip test if Data::Dumper not built + Subject: [PATCH] encoding and open pragmas + From: Jarkko Hietaniemi <jhi@iki.fi> + Date: Mon, 16 Aug 2004 22:27:00 +0300 + Message-ID: <41210A84.6060506@iki.fi> - [ 22967] - Skip tests if List::Util not built + [ 23384] + Upgrade to Encode 2.05 Branch: maint-5.8/perl - !> (integrate 31 files) + !> ext/Encode/AUTHORS ext/Encode/Changes ext/Encode/Encode.pm + !> ext/Encode/JP/JP.pm ext/Encode/META.yml ext/Encode/Makefile.PL + !> ext/Encode/bin/piconv ext/Encode/bin/ucmsort + !> ext/Encode/encoding.pm ext/Encode/lib/Encode/Alias.pm + !> ext/Encode/lib/Encode/Supported.pod + !> ext/Encode/ucm/big5-hkscs.ucm lib/open.pm lib/open.t + !> t/io/layers.t ____________________________________________________________________________ -[ 22985] By: nicholas on 2004/06/23 15:15:37 +[ 23388] By: nicholas on 2004/10/19 18:26:52 Log: Integrate: - [ 22907] - Upgrade to Test::Harness 2.42 + [ 23329] + Upgrade to Time::HiRes 1.65. + + [ 23330] + Upgrade to MIME::Base64 3.05. + + [ 23340] + A fix for [perl #31692] : as PerlIO::scalar accesses directly the + PV of the scalar it reads from, avoid to read it when it's an + undefined PV. - [ 22908] - Upgrade to Time::Local 1.10. + [ 23366] + Subject: AW: [perl #31864] IO::Poll - undef fd not checked in mask() + From: "Dintelmann, Peter" <Peter.Dintelmann@Dresdner-Bank.com> + Date: Mon, 11 Oct 2004 09:54:15 +0200 + Message-ID: <8FD9B6A658383E468B55D364D1A9951601857331@ffz00zm6.ffz00e.mail.dresdner.net> + Branch: maint-5.8/perl + !> ext/IO/lib/IO/Poll.pm ext/MIME/Base64/Base64.pm + !> ext/MIME/Base64/Changes ext/MIME/Base64/t/warn.t + !> ext/PerlIO/scalar/scalar.xs ext/PerlIO/t/scalar.t + !> ext/Time/HiRes/Changes ext/Time/HiRes/HiRes.pm + !> ext/Time/HiRes/HiRes.xs ext/Time/HiRes/Makefile.PL + !> ext/Time/HiRes/ppport.h ext/Time/HiRes/t/HiRes.t +____________________________________________________________________________ +[ 23387] By: nicholas on 2004/10/19 18:09:57 + Log: Integrate: + [ 23373] + Implement sv_svset _nosteal variants by passing a flag into + sv_set_flags rather than messing with the SvTEMP() flag on either + side of the call. - [ 22909] - Upgrade to Unicode::Collate 0.40 + [ 23374] + The second half of Perl_vwarner is actually a straight cut&paste job + from Perl_vwarn, so convert it into a (tail) call to Perl_vwarn. + cut&paste is bad, m'kay. - [ 22912] - Upgrade to Pod::LaTeX 0.57 + [ 23375] + Merge the common code from Perl_vdie and Perl_vwarner into a + S_vdie_common - [ 22914] - Upgrade to CGI.pm 3.05 + [ 23376] + Merge code from vdie and vcroak into S_vdie_croak_common + Branch: maint-5.8/perl + !> sv.c sv.h util.c +____________________________________________________________________________ +[ 23386] By: nicholas on 2004/10/19 16:56:17 + Log: Integrate: + [ 23321] + Subject: Re: [perl #31459] Bug in read() + From: Chris Heath <chris@heathens.co.nz> + Date: 06 Sep 2004 00:03:12 -0400 + Message-Id: <1094443392.12379.35.camel@linux.heathens.co.nz> - [ 22915] - Upgrade to Digest 1.08. + a read(F) into a UTF8-encoded buffer with an offset off the + end of the buffer, miss-calculated buffer lengths - [ 22916] - Upgrade to Pod::Perldoc 3.13 + [ 23337] + Subject: Patch for perl.c fixing an obscure environment bug + From: Merijn Broeren <merijnb@iloquent.com> + Date: Thu, 23 Sep 2004 17:18:17 +0200 + Message-ID: <20040923151817.GA15782@brugman.iloquent.nl> - [ 22920] - Upgrade to Pod::Parser 1.28 - (except Pod::Find, which has local patches not yet on CPAN) + [ 23342] + [perl #31767] open $1, "file" doesn't raise an exception - [ 22931] - Reapply change #20983, rolled back by change #22920, - as noticed by Craig Berry. + [ 23344] + Perl_sv_recode_to_utf8 shouldn't be returning SvPVX(sv) without + any check on whether it's valid. Branch: maint-5.8/perl - +> lib/Pod/Perldoc/t/01_about_verbose.t lib/Pod/t/user.t - !> MANIFEST lib/CGI.pm lib/CGI/Carp.pm lib/CGI/Util.pm - !> lib/CGI/t/html.t lib/Digest.pm lib/Pod/Checker.pm - !> lib/Pod/LaTeX.pm lib/Pod/ParseUtils.pm lib/Pod/Parser.pm - !> lib/Pod/Perldoc.pm lib/Pod/Perldoc/ToMan.pm - !> lib/Test/Harness.pm lib/Test/Harness/Changes - !> lib/Test/Harness/bin/prove lib/Test/Harness/t/prove-switches.t - !> lib/Time/Local.pm lib/Time/Local.t lib/Unicode/Collate.pm - !> lib/Unicode/Collate/t/hangul.t pod/pod2latex.PL - !> pod/pod2usage.PL pod/podchecker.PL pod/podselect.PL - !> t/pod/find.t + !> perl.c pp.c pp_sys.c sv.c t/io/open.t ____________________________________________________________________________ -[ 22984] By: nicholas on 2004/06/23 14:38:51 +[ 23385] By: nicholas on 2004/10/19 16:29:12 Log: Integrate: - [ 22906] - Patch 22835 Failed to upgrade all the new files in Encode 2.01 - As spotted by Jerry D. Hedden + [ 23155] + Build the perldelta copying command for the main Unix makefile with + buildtoc, so that it doesn't get forgotten on version increments. - [ 22911] - Upgrade to Unicode::Normalize 0.30. + [ 23370] + Include opmini.c in the dependency generation. + Branch: maint-5.8/perl + ! Makefile.SH + !> pod/buildtoc +____________________________________________________________________________ +[ 23335] By: nicholas on 2004/09/23 10:12:34 + Log: Integrate: + [ 23320] + [perl #30066] Memory leak in nested shared data structures in 5.8.4 + A pop of an item from a shared array ref causes a leak due to + AVf_REAL not having been set after an sv_upgrade(sv, SVt_PVAV). + Make sv_upgrade() set always this flag. + Branch: maint-5.8/perl + !> sv.c +____________________________________________________________________________ +[ 23328] By: nicholas on 2004/09/20 14:14:31 + Log: Integrate: + [ 23322] + Upgrade to Time::HiRes 1.63. + Note that it includes a ppport.h file. See if the one + previously built in Devel::PPPort can be used instead. + Branch: maint-5.8/perl + +> ext/Time/HiRes/ppport.h + !> MANIFEST ext/Time/HiRes/Changes ext/Time/HiRes/HiRes.pm + !> ext/Time/HiRes/HiRes.xs ext/Time/HiRes/Makefile.PL + !> ext/Time/HiRes/t/HiRes.t +____________________________________________________________________________ +[ 23324] By: steveh on 2004/09/17 16:31:49 + Log: Have usethreads set the same as useithreads on Win32 - [ 22970] - Subject: [PATCH] DB_File 1.809 was RE: [perl #30237] DB_File methods and substr don't mix - From: "Paul Marquess" <Paul.Marquess@btinternet.com> - Date: Tue, 22 Jun 2004 21:29:12 +0100 - Message-Id: <20040622202910.WBSU21846.mta08-svc.ntlworld.com@MARQUESSPT21> + This should fix the current ext/B/t/optree_*.t failures. + + Nicholas Clark and Andy Dougherty both say this is how it should be: + http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-09/msg00195.html + http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-09/msg00259.html Branch: maint-5.8/perl - !> ext/DB_File/Changes ext/DB_File/DB_File.pm - !> ext/DB_File/DB_File.xs ext/DB_File/t/db-btree.t - !> ext/DB_File/t/db-hash.t ext/DB_File/t/db-recno.t - !> ext/DB_File/typemap ext/Encode/Changes ext/Encode/Encode.pm - !> ext/Encode/META.yml ext/Unicode/Normalize/Changes - !> ext/Unicode/Normalize/Normalize.pm - !> ext/Unicode/Normalize/Normalize.xs - !> ext/Unicode/Normalize/t/illegal.t - !> ext/Unicode/Normalize/t/short.t - !> ext/Unicode/Normalize/t/split.t -____________________________________________________________________________ -[ 22983] By: nicholas on 2004/06/23 13:41:45 - Log: Integrate: - [ 22902] - Subject: Re: [PATCH] [perl #29841] utf8::decode doesn't work under -T - From: SADAHIRO Tomoyuki <bqw10602@nifty.com> - Date: Sun, 06 Jun 2004 00:37:21 +0900 - Message-Id: <20040606003344.57B2.BQW10602@nifty.com> - - [ 22976] - Add a regression test for bug #23765 (by Jarkko) - Branch: maint-5.8/perl - ! t/op/substr.t - !> lib/utf8.pm pod/perlapi.pod sv.c t/op/utftaint.t -____________________________________________________________________________ -[ 22982] By: nicholas on 2004/06/23 13:22:41 - Log: Integrate: - [ 22904] - Subject: Re: [PATCH] Re: Lack of error for large string on Solaris - From: Jarkko Hietaniemi <jhi@iki.fi> - Date: Mon, 07 Jun 2004 20:09:42 +0300 - Message-ID: <40C4A156.5030205@iki.fi> + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 23318] By: nicholas on 2004/09/10 16:27:07 + Log: Update the skips for the no perlio case + Branch: maint-5.8/perl + ! ext/B/t/optree_check.t ext/B/t/optree_concise.t + ! ext/B/t/showlex.t +____________________________________________________________________________ +[ 23317] By: nicholas on 2004/09/10 14:37:25 + Log: Integrate: + [ 23200] + Fix [perl #24269] socket() call uses non-IFS providers + causing subsequent print/read to hang or misbehave - [ 22922] - Remove the "malloc wrappage" tests, due to their unportability - (as suggested by Jarkko.) + Patch supplied by Artiom Morozov <artiom@phreaker.net> + in the bug report at http://rt.perl.org/rt3/index.html?q=24269 + + (strictly actually use the alternative supplied "stable" patch) + + [ 23275] + Implement new environment variable to allow the use of non-IFS + compatible LSP's on Windows to allow Perl to work in conjunction + with a firewall such as McAfee Guardian. + + Bug report and possible solutions by Ken Fox <kfox@ford.com>; + further assistance by Artiom Morozov <artiom@phreaker.net>. Branch: maint-5.8/perl - !> av.c pod/perldiag.pod pp.c pp_hot.c t/op/array.t t/op/repeat.t + ! win32/win32sck.c + !> README.win32 pod/perlrun.pod win32/Makefile win32/makefile.mk ____________________________________________________________________________ -[ 22981] By: nicholas on 2004/06/23 13:08:18 +[ 23316] By: nicholas on 2004/09/10 10:56:43 Log: Integrate: - [ 22876] - Subject: [PATCH] Fix anomalies in Carp functions - From: Steve Hay <steve.hay@uk.radan.com> - Date: Tue, 25 May 2004 16:05:02 +0100 - Message-ID: <40B3609E.5060502@uk.radan.com> + [ 23170] + Bug report #30132 was resolved before it was finished! + Here's the last piece in the puzzle. - [ 22883] - Subject: [PATCH] Shell.pm: pod rewrite and new mini-feature $Shell::raw - From: LAUN Wolfgang <wolfgang.laun@alcatel.at> - Date: Tue, 1 Jun 2004 07:52:58 +0200 - Message-ID: <DF27CDCBD2581D4B88431901094E4B4D02B0C744@attmsx1.aut.alcatel.at> + [ 23191] + Subject: [PATCH] extension to diagnostics.pm + From: Fergal Daly <fergal@esatclear.ie> + Date: Wed, 4 Aug 2004 00:33:09 +0100 + Message-ID: <20040803233309.GA239@dyn.fergaldaly.com> - [ 22886] - Subject: [Fwd: [PATCH] Pod::Find should ignore SCM files and dirs] - From: Alan Burlison <Alan.Burlison@sun.com> - Date: Fri, 28 May 2004 23:28:44 +0100 - Message-ID: <40B7BD1C.40309@sun.com> - - [ 22888] - Subject: [PATCH] Remove redundant %SIG assignments from FileCache - From: Alan Burlison <Alan.Burlison@Sun.COM> - Date: Fri, 28 May 2004 12:27:06 +0100 - Message-ID: <40B7220A.4040305@sun.com> - - [ 22898] - Carp was mostly unusable with Safe because it may require - Carp::Heavy at run-time (while require() is forbidden.) - Have Safe load Carp::Heavy. - - [ 22921] - Subject: [PATCH] Re: [perl #24081] invalid regexp in perl -V - From: Robin Barker <Robin.Barker@npl.co.uk> - Date: Wed, 9 Jun 2004 12:02:01 +0100 - Message-ID: <533D273D4014D411AB1D00062938C4D9040468F1@hotel.npl.co.uk> - with further adjustements for bleadperl - - [ 22938] - Subject: [PATCH] File::Basename docs - From: Boris Zentner <bzm@2bz.de> - Date: Sat, 12 Jun 2004 16:29:42 +0200 - Message-Id: <200406121629.42595.bzm@2bz.de> - - [ 22940] - More forgiving version comparison in perlivp. - - [ 22971] - Adjust array index in FileCache.pm. - - Subject: [perl #30291] Use of uninitialized value (array index reference) in FileCache.pm module at line 140 - From: bbucklan@jpl-devvax.jpl.nasa.gov (via RT) <perlbug-followup@perl.org> - Date: 15 Jun 2004 16:55:22 -0000 - Message-ID: <rt-3.0.9-30291-90552.18.5392299690759@perl.org> - - [ 22972] - Proposed patch + test case. - - Subject: [perl #30409] charnames.pm clobbers default variable - From: Marcel "Grünauer" (via RT) <perlbug-followup@perl.org> - Date: 22 Jun 2004 16:43:50 -0000 - Message-ID: <rt-3.0.9-30409-91174.12.8617678524438@perl.org> - Branch: maint-5.8/perl - !> configpm ext/Opcode/Safe.pm lib/Carp.pm lib/Carp.t - !> lib/Carp/Heavy.pm lib/Config.t lib/File/Basename.pm - !> lib/FileCache.pm lib/Pod/Find.pm lib/Shell.pm lib/autouse.t - !> lib/charnames.pm lib/charnames.t utils/perlivp.PL -____________________________________________________________________________ -[ 22980] By: nicholas on 2004/06/23 12:44:49 - Log: Integrate: - [ 22870] - [perl #29708] Problem with autouse (causing Perl to crash) - @_ sometimes wasn't getting created right - - [ 22913] - [perl #30061] double DESTROY in for loop - pp_iter decremented the ref count of the previous iterant before - unaliasing it. This could lead to DESTROY being called with the - loop variable still aliased to the freed value. If the DESTROY - also contained a for loop with the same iterator variable, the - freed value would get resurrected then freed for a second time. - - [ 22945] - As 2/3rds (or 3/4s) of the SV head structure is rewritten, it doesn't - seem that memzero() of everything is the most efficient idea. - - [ 22962] - fix typo in gp_free + [ 23221] + Subject: [PATCH] Document Carp's global variables + provide tests + From: "Jos I. Boumans" <kane@dwim.org> + Date: Mon, 16 Aug 2004 15:53:40 +0200 + Message-Id: <ADC6DEC6-EF8B-11D8-8425-000A95EF62E2@dwim.org> + (tests a bit reworked) + Branch: maint-5.8/perl + !> ext/IO/lib/IO/File.pm lib/Carp.pm lib/Carp.t + !> lib/diagnostics.pm +____________________________________________________________________________ +[ 23315] By: nicholas on 2004/09/10 10:34:45 + Log: Integrate: + [ 23280] + Upgrade to Devel::PPPort 3.02. - [ 22969] - Abolish the "Tied variable freed while still in use" error - I have - a way to cleanly avoid the coredump. + [ 23282] + Upgrade to Devel::PPPort 3.03. Branch: maint-5.8/perl - !> gv.c mg.c pad.c pod/perldiag.pod pp_ctl.c pp_hot.c sv.c - !> t/cmd/for.t t/op/goto.t t/op/tie.t + !> (integrate 29 files) ____________________________________________________________________________ -[ 22979] By: nicholas on 2004/06/23 10:32:34 +[ 23314] By: nicholas on 2004/09/10 10:24:09 Log: Integrate: - [ 22884] - Subject: [PATCH] configure.com and PERL_API_REVISION - From: "Craig A. Berry" <craigberry@mac.com> - Date: Mon, 31 May 2004 21:04:07 -0500 - Message-ID: <40BBE417.2090001@mac.com> + [ 23146] + Subject: [PATCH] Mention common dynaloader errors in perldiag.pod + From: "Jos I. Boumans" <kane@dwim.org> + Date: Wed, 21 Jul 2004 13:47:35 +0200 + Message-Id: <C226C05A-DB0B-11D8-A551-000A95EF62E2@dwim.org> + (with tweaks) - [ 22892] - Subject: Re: [PATCH] [perl #29612] ndbm failure in make test - From: Alexey Tourbin <at@altlinux.ru> - Date: Sat, 22 May 2004 02:22:22 +0400 - Message-ID: <20040521222222.GJ2030@solemn.turbinal.org> + [ 23148] + Grammar fix by Paul Johnson. - [ 22893] - Subject: [PATCH] on VMS, always exit with failure in my_failure_exit - From: "Craig A. Berry" <craigberry@mac.com> - Date: Tue, 01 Jun 2004 23:16:58 -0500 - Message-ID: <40BD54BA.9040708@mac.com> + [ 23151] + Sort perldiag. - [ 22901] - Subject: [PATCH] Have win32/makefile.mk default to gcc, and update docs - From: Steve Hay <steve.hay@uk.radan.com> - Date: Thu, 03 Jun 2004 15:46:17 +0100 - Message-ID: <40BF39B9.3060207@uk.radan.com> - - [ 22918] - Subject: [patch] Windows/Win32 thread handle leak with threads join - From: "Kevin Chase" <kevincha99@hotmail.com> - Date: Sun, 06 Jun 2004 09:44:44 -0700 - Message-ID: <BAY2-F172Ih5h5xf4rJ0001a3a6@hotmail.com> - - [ 22939] - Improve the substitution to cc_r for threading so that compilers - specified with a full path or as a parameter to ccache are changed - - [ 22975] - Backward compatibility issues for HP-UX 10.01 and older - Yes, it is still actively used in production environment - One more patch expected for toke.c optimization level - Branch: maint-5.8/perl - !> README.win32 configure.com ext/NDBM_File/hints/linux.pl - !> ext/threads/threads.xs hints/aix.sh hints/hpux.sh perl.c - !> win32/makefile.mk -____________________________________________________________________________ -[ 22978] By: nicholas on 2004/06/23 10:07:41 - Log: Integrate: - [ 22877] - Subject: [PATCH] Re: [perl #29969] h2ph not correctly processing glibc sys/sysmacros.ph - From: <wolfgang.laun@chello.at> - Date: Sun, 30 May 2004 17:27:07 +0200 - Message-Id: <20040530152707.ZLWL22856.viefep16-int.chello.at@localhost> - - [ 22925] - Make h2ph able to understand a limited set of inline functions. - The glibc apparently now ships headers that use inline functions - instead of plain old macros. - - [ 22929] - More h2ph tweaking for gcc __inline functions - - [ 22930] - More h2ph tweaks: recognition of C types - - [ 22933] - More h2ph voodoo. - Branch: maint-5.8/perl - !> utils/h2ph.PL -____________________________________________________________________________ -[ 22974] By: nicholas on 2004/06/22 21:59:24 - Log: Integrate: - [ 22882] - Subject: [PATCH] perlhack.pod - working with the Perl source - From: Dave Rolsky <autarch@urth.org> - Date: Mon, 31 May 2004 12:52:43 -0500 (CDT) - Message-ID: <Pine.LNX.4.58.0405311250520.7714@urth.org> - - [ 22885] - Subject: Re: [PATCH] UPDATE - Grammatical fixes and explanations in perlfunc.pod (sysopen) - From: Paul Fenwick <pjf@perltraining.com.au> - Date: Tue, 1 Jun 2004 11:31:34 +1000 - Message-ID: <20040601013134.GA11005@perltraining.com.au> - - [ 22890] - Subject: [PATCH] Re: [perl #29765] PERL-5.8.4 INSTALL - From: Andrew Dougherty <doughera@lafayette.edu> - Date: Tue, 1 Jun 2004 16:25:48 -0400 (EDT) - Message-ID: <Pine.SOL.4.58.0406011619090.4066@maxwell.phys.lafayette.edu> - - [ 22891] - Detypo. - - [ 22895] - Fix apidoc entries for PUSHMARK and newXSproto. - - [ 22900] - perlpodspec uses 'nonbreaking' and 'non-breaking'. - Normalize on the hyphenated spelling. - - [ 22903] - Subject: [perl #30073] Misleading docs of Text::Wrap - From: perl-5.8.0@ton.iguana.be (via RT) <perlbug-followup@perl.org> - Date: 6 Jun 2004 21:50:19 -0000 - Message-ID: <rt-3.0.9-30073-89834.19.0927626986204@perl.org> - - [ 22905] - Subject: Re: newSVpvn(NULL, 0); doesn't work as advertised - From: Marcus Holland-Moritz <mhx-perl@gmx.net> - Date: Fri, 4 Jun 2004 16:29:44 +0200 - Message-Id: <20040604162944.4011f1c6@r2d2> + [ 23159] + make a note in perlrun that -i doesn't preserve UNIX hard links. + + [ 23160] + document that -i messes soft as well hard hard links. - [ 22910] - Remove a spurious \n in a perltie example, - noticed by Geoffrey Young. + [ 23164] + Subject: [perl #7558] [PATCH] README.solaris + From: Andy Dougherty <doughera@lafayette.edu> + Date: Mon, 26 Jul 2004 15:32:35 -0400 (EDT) + Message-Id: <Pine.SOL.4.58.0407261530350.19559@maxwell.phys.lafayette.edu> - [ 22917] - Several updates, major, and minor corrections, model updates, - explained the model numbering of HP-UX servers. + Add more info on /dev/random under solaris - [ 22919] - s/64bit/64-bit/g for consistency in the READMEs. + [ 23165] + Subject: Re: AW: [perl #7558] [PATCH] README.solaris + From: Andy Dougherty <doughera@lafayette.edu> + Date: Tue, 27 Jul 2004 14:12:06 -0400 (EDT) + Message-ID: <Pine.SOL.4.58.0407271335550.22839@maxwell.phys.lafayette.edu> + + [ 23172] + A few minor updates to README.win32 (aka perlwin32) + + [ 23182] + Subject: [PATCH] mention refaddr() in overload::StrVal docs + From: Fergal Daly <fergal@esatclear.ie> + Date: Fri, 30 Jul 2004 16:09:19 +0100 + Message-ID: <20040730150919.GB19022@dyn.fergaldaly.com> + + [ 23184] + Enhance the caveat in the description of tell() + + Subject: Re: [perl #30788] Error in documentation + From: Nick Ing-Simmons <nick@ing-simmons.net> + Date: Wed, 28 Jul 2004 15:12:54 +0100 + Message-Id: <20040728141254.3861.5@llama.ing-simmons.net> + + [ 23205] + Add a note in perltodo about a potential extension of readpipe() + + [ 23220] + Subject: Updates to modules-related pod + From: Kirrily Skud Robert <skud@infotrope.net> + Date: Mon, 16 Aug 2004 16:00:14 -0400 + Message-ID: <20040816200014.GC27764@infotrope.net> + + [ 23224] + Add notes for building with MS VC++ Toolkit 2003 + + [ 23227] + Delete superfluous "with". + + [ 23236] + Grammatical nit by Hugo. + + [ 23240] + Pumpkinship updates + + [ 23250] + From: david nicol <whatever@davidnicol.com> + Subject: [perl #31228] no no-op + Message-Id: 1093659222.1436.70.camel@plaza.davidnicol.com> + Date: 27 Aug 2004 21:13:42 -0500 + + Document that 0 and 1 can (sort of) be used as no-ops. + + [ 23276] + Subject: [PATCH] perlintro.pod + From: Paul Johnson <paul@pjcj.net> + Date: Tue, 7 Sep 2004 15:13:51 +0200 + Message-ID: <20040907131351.GD2513@pjcj.net> + + [ 23281] + Subject: [perl #21553] Re: Solaris Perl (fwd) + From: Andy Dougherty <doughera@lafayette.edu> + Date: Wed, 8 Sep 2004 11:32:26 -0400 (EDT) + Message-Id: <Pine.SOL.4.58.0409081129180.17582@maxwell.phys.lafayette.edu> + Clarify whether it's safe to replace the perl bundled with Solaris + + [ 23283] + Subject: [PATCH-5.8.5] lib/bigint.pm tiny typo fix + From: "Konovalov, Vadim" <vkonovalov@spb.lucent.com> + Date: Mon, 6 Sep 2004 11:09:51 +0400 + Message-ID: <7DD1BE2C50259746ABB8683672D2089E081132@itotest-1.spb.lucent.com> + Branch: maint-5.8/perl + ! pod/perldiag.pod + !> README.solaris README.win32 lib/bigint.pm lib/overload.pm + !> pod/perlfunc.pod pod/perlhack.pod pod/perlintro.pod + !> pod/perlnewmod.pod pod/perlop.pod pod/perlrun.pod + !> pod/perltodo.pod +____________________________________________________________________________ +[ 23313] By: nicholas on 2004/09/10 09:56:57 + Log: Integrate: + [ 23277] + Subject: SvO?OK_off()'s return value + From: Marcus Holland-Moritz <mhx-perl@gmx.net> + Date: Sun, 1 Aug 2004 12:46:48 +0200 + Message-Id: <20040801124648.7f9b3cee@r2d2> - [ 22923] - Subject: Re: [perl #30045] Transliteration replacement not terminated message obscure + Move (void) casts into SvOOK_off macro. + Branch: maint-5.8/perl + ! pp_ctl.c + !> gv.c mg.c perl.c pp.c pp_hot.c scope.c sv.c sv.h +____________________________________________________________________________ +[ 23312] By: nicholas on 2004/09/10 09:20:53 + Log: Integrate: + [ 23218] + Subject: [PATCH] make cygwin ld2 executable From: Yitzchak Scott-Thoennes <sthoenna@efn.org> - Date: Mon, 7 Jun 2004 00:28:55 -0700 - Message-ID: <20040607072854.GB1028@efn.org> + Date: Sun, 15 Aug 2004 17:14:59 -0700 + Message-ID: <20040816001252.GA2148@efn.org> - [ 22927] - Remove a warning against unsafe signals in perlipc.pod, - now that we have "safe signals". + [ 23219] + Subject: [PATCH] running mktables on VMS + From: "Craig A. Berry" <craigberry@mac.com> + Date: Tue, 10 Aug 2004 22:28:04 -0500 + Message-ID: <41199244.9020706@mac.com> - [ 22936] - Subject: [PATCH] perlop.pod: add an example to the .. and ... operators - From: Shlomi Fish <shlomif@vipe.technion.ac.il> - Date: Tue, 15 Jun 2004 10:15:15 +0300 (IDT) - Message-ID: <Pine.LNX.4.56.0406151013140.14618@vipe.technion.ac.il> + [ 23274] + Subject: [PATCH] -Dunlink_all_versions for VMS + From: "Craig A. Berry" <craigberry@mac.com> + Date: Sat, 04 Sep 2004 11:58:56 -0500 + Message-ID: <4139F450.7040708@mac.com> Branch: maint-5.8/perl - !> INSTALL README README.aix README.hpux XSUB.h lib/Text/Wrap.pm - !> pod/perlapi.pod pod/perldiag.pod pod/perlfunc.pod - !> pod/perlhack.pod pod/perlintern.pod pod/perlipc.pod - !> pod/perlop.pod pod/perlpodspec.pod pod/perltie.pod pp.h - !> pp_ctl.c sv.c + !> configure.com cygwin/Makefile.SHs vms/descrip_mms.template ____________________________________________________________________________ -[ 22973] By: nicholas on 2004/06/22 21:35:46 +[ 23311] By: nicholas on 2004/09/10 09:09:38 Log: Integrate: - [ 22824] - Fix new B::Concise test output - Subject: Re: Smoke [5.9.2] 22820 FAIL(F) openbsd 3.5 (i386/1 cpu) - From: Jim Cromie <jcromie@divsol.com> - Date: Mon, 17 May 2004 09:19:00 -0600 - Message-ID: <40A8D7E4.1020007@divsol.com> + [ 23225] + Mark a test that relies on tainting behavior as TODO on Windows. - (the t/TEST part) - [ 22875] - Subject: [PATCH] Fix generation of perlapi.pod - From: Steve Hay <steve.hay@uk.radan.com> - Date: Fri, 28 May 2004 11:46:41 +0100 - Message-ID: <40B71891.6090806@uk.radan.com> + Should have been part of integration 23310, but for + http://www.google.com/search?q=%66%75%63%6Bing+perforce + Branch: maint-5.8/perl + !> t/comp/opsubs.t +____________________________________________________________________________ +[ 23310] By: nicholas on 2004/09/10 08:57:45 + Log: Integrate: + [ 23206] + Subject: Patch for t/op/sleep.t + From: Andy Lester <andy@petdance.com> + Date: Mon, 9 Aug 2004 00:11:51 -0500 + Message-ID: <20040809051151.GA13872@petdance.com> - [ 22878] - Subject: [perl #29937] Entries missing from .packlist - From: jdhedden@1979.usna.com (via RT) <perlbug-followup@perl.org> - Date: 28 May 2004 19:23:48 -0000 - Message-ID: <rt-3.0.9-29937-88315.2.18472609678159@perl.org> + [ 23215] + Subject: Test for functions with operator names + From: Andy Lester <andy@petdance.com> + Date: Thu, 12 Aug 2004 11:31:03 -0500 + Message-ID: <20040812163103.GA26687@petdance.com> - [ 22894] - Document embed.fnc 'U' and 's' flags. + [ 23253] + Subject: PATCH: Taintedness and ternary conditional + From: Andy Lester <andy@petdance.com> + Date: Thu, 26 Aug 2004 23:44:47 -0500 + Message-Id: <20040827044447.GA5268@petdance.com> - [ 22932] - Subject: [PATCH] t/TEST - From: Abe Timmerman <abe@ztreet.demon.nl> - Date: Sun, 13 Jun 2004 11:41:49 +0200 - Message-Id: <200406131141.50361.abe@ztreet.demon.nl> + add tests and documentation to the effect that ($tainted ? $a : $b) + doesn't necessarily return a tainted value. Also tidy the markup in + perldoc.pod Branch: maint-5.8/perl - !> autodoc.pl embed.fnc installman installperl pod/perlapi.pod - !> t/TEST + +> t/comp/opsubs.t + !> MANIFEST pod/perlsec.pod t/op/sleep.t t/op/taint.t ____________________________________________________________________________ -[ 22871] By: nicholas on 2004/05/30 15:36:14 - Log: Update Changes +[ 23309] By: nicholas on 2004/09/10 08:41:17 + Log: Integrate: + [ 23179] + Skip test when building without Encode. + + [ 23181] + Fix breakage caused by Change 23179 + + [ 23244] + Skip a Data::Dumper test if configured without B module. + + [ 23245] + Fix skipping of a Dumpvalue test when configured without Devel::Peek. + + [ 23246] + Skip Time::HiRes tests if configured without that module. Branch: maint-5.8/perl - ! Changes patchlevel.h + !> ext/Data/Dumper/t/dumper.t ext/Time/HiRes/t/HiRes.t + !> lib/Dumpvalue.t t/run/fresh_perl.t ____________________________________________________________________________ -[ 22869] By: nicholas on 2004/05/30 14:26:17 - Log: Integrate: - [ 22835] - Upgrade to Encode 2.00. +[ 23308] By: nicholas on 2004/09/10 07:28:09 + Log: + Integrate: + [ 23173] + Fix and update Perl_grok_* docs. + + [ 23176] + Add comment to the top of most .c files explaining their purpose - [ 22842] - Subject: Re: utf-8 and taint don't work together - From: SADAHIRO Tomoyuki <bqw10602@nifty.com> - Date: Sat, 22 May 2004 21:38:33 +0900 - Message-Id: <20040522212704.C068.BQW10602@nifty.com> + [ 23180] + Add comment to top of reentr.c and fix typos in other files - Date: Sun, 23 May 2004 09:56:15 +0900 - Message-Id: <20040523095609.E404.BQW10602@nifty.com> + [ 23187] + more typo fixes for change 3176 (comments at top of .c files) - [ 22843] - Tests for change #22842, by SADAHIRO Tomoyuki - (adapted to the core) + [ 23195] + Comment describing purpose. - [ 22866] - Skip in minitest + [ 23196] + Document sv_catpvn_nomg, sv_setsv_nomg and sv_catsv_nomg. - [ 22868] - Upgrade to Encode 2.01. + [ 23207] + fix minor nit in file description, to keep Jarkko happy + + [ 23214] + Subject: api doc fix for SvSetMagicSV_nosteal + From: Stas Bekman <stas@stason.org> + Date: Thu, 12 Aug 2004 18:10:36 -0700 + Message-ID: <411C150C.5020602@stason.org> + Branch: maint-5.8/perl + !> (integrate 37 files) +____________________________________________________________________________ +[ 23307] By: nicholas on 2004/09/10 06:45:43 + Log: + Email change for Steffen Mueller. + + [ 23162] + Windows-related updates to Porting/repository.pod Branch: maint-5.8/perl - +> t/op/utftaint.t - !> (integrate 150 files) + !> AUTHORS Porting/repository.pod ____________________________________________________________________________ -[ 22867] By: nicholas on 2004/05/30 13:24:02 +[ 23306] By: nicholas on 2004/09/10 06:39:03 Log: Integrate: - [ 22817] - Subject: [perl #29527] Perl 5.8.4 build problems on LynxOS - From: Olli Savia (via RT) <perlbug-followup@perl.org> - Date: 12 May 2004 13:02:41 -0000 - Message-ID: <rt-3.0.9-29527-87290.17.3367022021997@perl.org> + [ 23126] + Encourage compilers to tail call optimise in sv_savepv, sv_savepvn + and sv_savesharedpv. Need to create non-void returning versions of + Copy and Zero, as the existing macros deliberately cast to (void) - [ 22841] - Subject: [PATCH] win32_chsize is not exported on Win32 - From: Steve Hay <steve.hay@uk.radan.com> - Date: Mon, 24 May 2004 12:52:48 +0100 - Message-ID: <40B1E210.4050202@uk.radan.com> + [ 23135] + Turn 2 strcpy()s into memcpy() because we know the length. Branch: maint-5.8/perl - !> makedef.pl sv.c + !> handy.h malloc.c perl.c pod/perlapi.pod sv.c toke.c util.c ____________________________________________________________________________ -[ 22865] By: nicholas on 2004/05/30 13:01:21 +[ 23305] By: nicholas on 2004/09/10 06:25:00 Log: Integrate: - [ 22822] - David Manura is the new maintainer of Text::Balanced. + [ 23122] + oslevel can fail on AIX, but the output generated would confuse + Configure - [ 22840] - Subject: [PATCH] Re: [perl #29765] PERL-5.8.4 INSTALL - From: Yitzchak Scott-Thoennes <sthoenna@efn.org> - Date: Fri, 21 May 2004 11:35:34 -0700 - Message-ID: <20040521183533.GA5108@efn.org> - (plus whitespace removal) + [ 23124] + Be sure HP-UX' ANSI C compiler's PATH is found *before* + the path to the bundled braindead C compiler. This might + influence ccache's behaviour in finding the correct path - [ 22852] - Subject: TEST needs to ignore SCM files - From: Alan Burlison <Alan.Burlison@sun.com> - Date: Thu, 27 May 2004 23:32:28 +0100 - Message-ID: <40B66C7C.8030303@sun.com> + [ 23174] + First steps towards an explicit perl.exp-less AIX build + Previous method can still be used by undeffing usenativedlopen + If that is ever tested at all on AIX + + [ 23188] + gcc on AIX doesn't like -G on the commandline + + [ 23189] + gcc on AIX 4 doesn't like -G on the commandline too Branch: maint-5.8/perl - !> INSTALL Porting/Maintainers.pl t/TEST + !> Configure hints/aix.sh hints/aix_4.sh ____________________________________________________________________________ -[ 22864] By: nicholas on 2004/05/30 12:38:30 +[ 23304] By: nicholas on 2004/09/10 06:04:43 Log: Integrate: - [ 22769] - Subject: [perl #29073] Reference to incorrect method in documentation of - From: "bob@starlabs.net (via RT)" <perlbug-followup@perl.org> - Message-ID: <rt-3.0.8-29073-85903.18.1381766820328@perl.org> - Date: 22 Apr 2004 10:49:22 -0000 + [ 23111] + This seems to be needed to get COW working on Win32 - [ 22829] - perlrun.pod minor fixes : - - the parameter to -x is optional - - pod nit + [ 23121] + Some calls to PerlMemShared_alloc() aren't checking the return value. + Bug spotted by Nigel Sandever - [ 22837] - Subject: Proposed doc patch for getsockopt - From: perl5-porters@ton.iguana.be (Ton Hospel) - Date: Sun, 16 May 2004 13:35:20 +0000 (UTC) - Message-Id: <c87qmo$u9b$1@post.home.lunix> + [ 23128] + Use VirtualAlloc() more flexibly when using it to mimic UNIX's sbrk(). + From: Steve Hay <steve.hay@uk.radan.com> + CC: perl-win32-porters@listserv.ActiveState.com + Message-ID: <40F6B295.8010804@uk.radan.com> - [ 22853] - Subject: [PATCH doc] Re: undef loses it magicness when assigned to a variable? - From: Stas Bekman <stas@stason.org> - Date: Thu, 27 May 2004 11:25:08 -0700 - Message-ID: <40B63284.5040203@stason.org> + Assumes perl's malloc can now handle non-contiguous memory (believed + to be true). + Does not address threading issues. + + "The attached patch (against blead) makes sbrk() initially try to + extend the existing block of memory exactly as it currently does, but + to not fail immediately if it can't -- it now frees up that part of + whatever it had previously reserved+committed which hadn't actually + been used yet, resets all its static variables and basically starts + anew." Branch: maint-5.8/perl - !> lib/Text/ParseWords.pm pod/perlapi.pod pod/perlfunc.pod - !> pod/perlguts.pod pod/perlrun.pod sv.h + !> ext/threads/threads.xs util.c win32/win32.c ____________________________________________________________________________ -[ 22863] By: nicholas on 2004/05/30 11:38:17 +[ 23303] By: nicholas on 2004/09/10 05:25:22 Log: Integrate: - [ 22756] - Subject: [PATCH] Document limitations in PUSHi et al macros and add new mPUSHi et al macros - From: Steve Hay <steve.hay@uk.radan.com> - Date: Fri, 30 Apr 2004 10:07:21 +0100 - Message-ID: <40921749.3050600@uk.radan.com> + [ 23091] + Check each line of config_re output. + + [ 23147] + Config::config_re and config_sh would report the byteorder as 'ffff' + + [ 23185] + Subject: [PATCH] additional -V:foo tests + From: Jim Cromie <jcromie@divsol.com> + Date: Mon, 02 Aug 2004 09:15:23 -0600 + Message-ID: <410E5A8B.9030307@divsol.com> + Branch: maint-5.8/perl + !> configpm lib/Config.t pod/perlrun.pod +____________________________________________________________________________ +[ 23302] By: nicholas on 2004/09/09 21:45:33 + Log: Integrate: + [ 23023] + [perl #30258] utf8 POPSTACK crash on split execution + split() does a SWITCHSTACK to directly split to an array, but + if it subsequently dies (eg the regex triggers a 'use utf8' which + is then denied by Safe), then the switch doesn't get undone. Add + a new save type to allow for this. + + [ 23150] + Subject: Re: "Too late for -T" could be more descriptive + From: Jim Cromie <jcromie@divsol.com> + Date: Wed, 21 Jul 2004 11:21:50 -0600 + Message-ID: <40FEA62E.2010809@divsol.com> + (with tweaks) - [ 22757] - Follow-up to previous patch: the mX?PUSH[inup] macros - should handle 'set' magic, just like the X?PUSH[inup] - counterparts. + [ 23158] + [perl #30733] memory leak in array delete + av_delete() wasn't mortalizing the returned value - [ 22779] - Fix mX?PUSH[inup] macros. (Follow-up to #22756 and #22757) + [ 23209] + eval_sv() failing a taint test could corrupt the stack - Subject: Re: [PATCH] Document limitations in PUSHi et al macros and add new mPUSHi et al macros - From: Marcus Holland-Moritz <mhx-perl@gmx.net> - Date: Mon, 3 May 2004 20:03:28 +0200 - Message-Id: <20040503200328.24efcda5@r2d2> + [ 23210] + Fix a typo and remove some debugging crud from change #23209 - [ 22783] - Add tests for mX?PUSH[inup] macros. + [ 23271] + only mortalize deleted array elements for AvREAL + (update to change #23158) - Subject: Re: [PATCH] Document limitations in PUSHi et al macros and add new mPUSHi et al macros - From: Steve Hay <steve.hay@uk.radan.com> - Date: Wed, 05 May 2004 15:34:45 +0100 - Message-ID: <4098FB85.1060602@uk.radan.com> + [ 23279] + Add MY_CXT_CLONE to the core. (Taken from Time::HiRes.) See also: + http://groups.google.com/groups?selm=r5l1vv00ca033k7a06d40fgei1ion91rnp%404ax.com Branch: maint-5.8/perl - +> ext/XS/APItest/t/push.t - !> MANIFEST ext/XS/APItest/APItest.pm ext/XS/APItest/APItest.xs - !> ext/XS/APItest/MANIFEST pod/perlapi.pod pod/perlguts.pod pp.h + !> av.c ext/XS/APItest/t/call.t perl.c perl.h pod/perldebug.pod + !> pod/perldiag.pod pod/perlrun.pod pp.c scope.c scope.h + !> t/op/delete.t ____________________________________________________________________________ -[ 22862] By: nicholas on 2004/05/30 10:09:57 +[ 23301] By: nicholas on 2004/09/09 16:17:05 Log: Integrate: - [ 22662] - C<undef> doesn't look like a number. See also: - - Subject: Re: [perl #27606] undef "looks like" a number - From: Marcus Holland-Moritz <mhx-perl@gmx.net> - Date: Mon, 15 Mar 2004 22:16:26 +0100 - Message-Id: <20040315221626.48061c67@r2d2> + [ 23300] + A single version of B that supports 5.8 and 5.10 - [ 22798] - [perl #29395] Scalar::Util::refaddr falsely returns false - Add mg_get() to refaddr() when SV is magical. - Fix the non-xs version of looks_like_number(). - [ 22838] - Update to Scalar-List-Utils-1.14 + Plus some edits to remove the last differences on the maint side. Branch: maint-5.8/perl - +> ext/List/Util/Changes - - ext/List/Util/ChangeLog - ! ext/List/Util/t/lln.t pod/perl585delta.pod - !> MANIFEST ext/List/Util/README ext/List/Util/Util.xs - !> ext/List/Util/lib/List/Util.pm - !> ext/List/Util/lib/Scalar/Util.pm ext/List/Util/t/refaddr.t - !> pp_ctl.c sv.c + ! ext/B/B.pm ext/B/B/C.pm + !> ext/B/B.xs ext/B/ramblings/runtime.porting ext/B/t/lint.t ____________________________________________________________________________ -[ 22861] By: nicholas on 2004/05/30 09:43:49 +[ 23299] By: nicholas on 2004/09/09 15:44:32 + Log: Synchronise the opname regexp with blead. + (No harm in including dor, as nothing in maint will generate that) + Branch: maint-5.8/perl + ! ext/B/B.pm +____________________________________________________________________________ +[ 23298] By: nicholas on 2004/09/09 13:46:42 + Log: Undo integration edit to make file identical with blead. + Expectation munging now done conditionally on perl version. + Branch: maint-5.8/perl + ! ext/B/t/stash.t +____________________________________________________________________________ +[ 23297] By: nicholas on 2004/09/09 13:34:25 Log: Integrate: - [ 22816] - Make XSLoader update @DynaLoader::dl_shared_objects. + [ 23212] + Subject: 2 patches: goto.t, B.pm/xs + From: Jim Cromie <jcromie@divsol.com> + Date: Sun, 08 Aug 2004 18:42:47 -0600 + Message-ID: <4116C887.9080400@divsol.com> - [ 22823] - Subject: [PATCH] Re: [perl #29581] glob() misses a lot of matches - From: LAUN Wolfgang <wolfgang.laun@alcatel.at> - Date: Mon, 17 May 2004 07:38:19 +0200 - Message-ID: <DF27CDCBD2581D4B88431901094E4B4D02B0C71E@attmsx1.aut.alcatel.at> - - [ 22828] - Subject: [perl #29623] Patch for h2xs.t in Perl 5.8.4 - From: mats@sm5sxl.net (via RT) <perlbug-followup@perl.org> - Date: 16 May 2004 13:33:32 -0000 - Message-ID: <rt-3.0.9-29623-87522.10.1965589695082@perl.org> - - [ 22836] - Subject: [PATCH] h2xs doesn't recognize indented enums - From: Tassilo von Parseval <tassilo.parseval@post.rwth-aachen.de> - Date: Fri, 21 May 2004 10:51:58 +0200 - Message-id: <20040521085158.GA10660@ethan> - (modified regexp) - - [ 22848] - Subject: [PATCH] correctly handle C<< >> and C<<< >>> in diagnostics - From: Yitzchak Scott-Thoennes <sthoenna@efn.org> - Date: Tue, 25 May 2004 02:29:37 -0700 - Message-ID: <20040525092937.GA2332@efn.org> + [ 23249] + Subject: [ PATCH ] 2 added private flags for B::Concise + From: Jim Cromie <jcromie@divsol.com> + Date: Tue, 31 Aug 2004 23:19:54 -0600 + Message-Id: <41355BFA.8010900@divsol.com> - [ 22850] - Subject: [PATCH] 'perl -v' fails if local_patches contains code snippets - From: Alan Burlison <Alan.Burlison@sun.com> - Date: Wed, 26 May 2004 16:24:03 +0100 - Message-ID: <40B4B693.9090905@sun.com> - (using \0 as a separator for q//) + The OPpENTERSUB_NOMOD and OPpCONST_SHORTCIRCUIT flags weren't + displayed by B::Concise. Branch: maint-5.8/perl - !> ext/DynaLoader/DynaLoader_pm.PL ext/DynaLoader/XSLoader_pm.PL - !> ext/File/Glob/Glob.xs lib/diagnostics.pm lib/h2xs.t perl.c - !> utils/h2xs.PL + !> ext/B/B.pm ext/B/B.xs ext/B/B/Concise.pm ____________________________________________________________________________ -[ 22860] By: nicholas on 2004/05/29 22:13:46 +[ 23296] By: nicholas on 2004/09/09 12:58:00 Log: Integrate: - [ 22830] - [perl #29637] Thread creation time is hypersensitive + [ 23105] + Lots of tests for for reverse ... + + [ 23108] + Optimise foreach my $i (reverse ...) + foreach without a lexical iterator not yet optimised - Due to a logic error, the dup ptr table sometimes wans't being - grown, leading to extremely slow cloning. + [ 23109] + "That's the way to do it" + In taking out a bug spotted by my regression tests in t/cmd/for.t + I actually managed to disable the entire optimisation. Which means + that I didn't find the other bug. This optimisation is live, and + passes all tests. - [ 22831] - improve hashing algorithm for ptr tables in perl_clone: - the bottom few bits of a pointer are usually zero + [ 23112] + The optrees for C<for $_ (...)> and C<for (...)> differ, so even more + tests. + + [ 23113] + Now optimising for $a (reverse ...) + + [ 23114] + Optimise for (reverse ...) + + [ 23115] + for (reverse @foo) now iterates in reverse in place. Branch: maint-5.8/perl - !> sv.c + ! op.c + !> ext/B/B/Concise.pm op.h pp_ctl.c pp_hot.c t/cmd/for.t ____________________________________________________________________________ -[ 22859] By: nicholas on 2004/05/29 21:52:37 +[ 23295] By: nicholas on 2004/09/09 11:25:08 + Log: Jarkko had reverted ext/B/t/bytecode.t with change 20434. + Hence it was gone from the MANIFEST. Re-integrating it may prove to + be foolish on my part, but let's give it a smoke for now. + Branch: maint-5.8/perl + ! MANIFEST +____________________________________________________________________________ +[ 23294] By: nicholas on 2004/09/09 11:12:47 Log: Integrate: - [ 22771] - ensure that utf8 Perl code magically called from a regex localizes $. + [ 21566] + Subject: [PATCH lib/overload.t] TODO tests for bug #24313. + From: Abigail <abigail@abigail.nl> + Date: Mon, 27 Oct 2003 13:05:37 +0100 + Message-ID: <20031027120536.GA24608@abigail.nl> + + Subject: [PATCH bleadperl] [perl #24313] (was Re: [PATCH lib/overload.t] TODO tests for bug #24313.) + From: Rick Delaney <rick@bort.ca> + Date: Mon, 27 Oct 2003 12:17:49 -0500 + Message-ID: <20031027121749.E2233@biff.bort.ca> - [ 22772] - remove spurious intentation in utf8_pva.pl + [ 23106] + Numeric comparison operators mustn't compare addresses of references + that are overloaded. Branch: maint-5.8/perl - !> lib/utf8_pva.pl + !> lib/overload.t pp.c pp_hot.c toke.c ____________________________________________________________________________ -[ 22858] By: nicholas on 2004/05/29 21:04:22 - Log: Integrate 22744, 22760, 22761, 22762, 22763, 22765 redux +[ 23293] By: nicholas on 2004/09/09 10:15:43 + Log: Integrate: + [ 23242] + Skip ext/B/t/assembler.t when configured without B. - http://www.google.com/search?btnI=again&q=perforce+fails+bah + [ 23243] + Fix typo in B::Assembler. Branch: maint-5.8/perl - - lib/unicore/lib/gc_sc/Sterm.pl - !> lib/unicore/lib/gc_sc/Dash.pl lib/unicore/lib/gc_sc/Hyphen.pl - !> lib/unicore/lib/gc_sc/Radical.pl + !> ext/B/B/Assembler.pm ext/B/t/assembler.t ____________________________________________________________________________ -[ 22857] By: nicholas on 2004/05/29 20:48:27 +[ 23292] By: nicholas on 2004/09/09 09:55:09 Log: Integrate: - [ 22744] - Subject: [PATCH utf8_heavy.pl, mktables, et. al.] candidate for TR18 compliance - From: Jeff 'japhy' Pinyan <japhy@perlmonk.org> - Date: Thu, 22 Apr 2004 14:31:30 -0400 (EDT) - Message-ID: <Pine.LNX.4.44.0404221429040.10466-101000@perlmonk.org> + [ 23093] + The current optimisation for sort {$b cmp $a} is bogus now that we + guarantee a stable sort. Disable it, pending a correct optimisation. - Date: Mon, 26 Apr 2004 12:37:21 -0400 (EDT) - Message-ID: <Pine.LNX.4.44.0404261222320.7154-400000@perlmonk.org> + [ 23096] + A proper, working, stable optimisation for sort {$b cmp $a} - [ 22760] - Remove the no-longer autogenerated Unicode files + [ 23097] + Also test reverse sort in scalar context - [ 22761] - Avoid mktables generating Sterm.pl and Sterm.pl in the same directory - by making the %BaseName check global + [ 23098] + Test reverse sort as the return from a function in list and scalar + contexts. - [ 22762] - Some fool removed lib/unicore/ArabicShaping.txt in change 22760 + [ 23099] + Check that non-optimimisable sort comparisons work when reversed + (Not optimised yet, but might be coming soon) - [ 22763] - And that same fool forgot to add the not-really-needed "fuzzy" versions - of some binary property files + [ 23100] + check that reverse (sort (@a), @b) etc work. + Join some lines that don't need wrapping - [ 22765] - Make t/uni/class.t pass on case insensitive file systems + [ 23102] + Optimise list context reverse sort to reverse as part of the sort op + + [ 23166] + Subject: Re: more 5.9 sort tests (second draft) + From: david nicol <whatever@davidnicol.com> + Date: 21 Jul 2004 17:10:05 -0500 + Message-Id: <1090447805.995.24.camel@plaza.davidnicol.com> Branch: maint-5.8/perl - +> (branch 410 files) - - (delete 322 files) - !> MANIFEST lib/unicore/Canonical.pl - !> lib/unicore/CombiningClass.pl lib/unicore/Decomposition.pl - !> lib/unicore/Exact.pl lib/unicore/Name.pl - !> 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 pod/perlunicode.pod - !> t/op/pat.t t/uni/class.t + ! op.c + !> ext/B/B/Concise.pm ext/B/t/f_sort.t op.h pp_sort.c t/op/sort.t ____________________________________________________________________________ -[ 22856] By: nicholas on 2004/05/29 20:04:40 +[ 23291] By: nicholas on 2004/09/09 09:22:38 Log: Integrate: - [ 22693] - Subject: [PATCH] lib/utf8_heavy.pl -- cascading classes and '&' support - From: Jeff 'japhy' Pinyan <japhy@perlmonk.org> - Date: Mon, 12 Apr 2004 20:24:48 -0400 (EDT) - Message-ID: <Pine.LNX.4.44.0404122011160.3038-200000@perlmonk.org> + [ 23046] + Subject: Re: [perl #30504] B::Deparse scoping problem with for loop + From: Stephen McCamant <smcc@MIT.EDU> + Date: Mon, 28 Jun 2004 18:26:24 -0700 + Message-ID: <16608.50496.787002.560481@apocalypse.OCF.Berkeley.EDU> - [ 22713] - Subject: Re: [PATCH] lib/utf8_heavy.pl -- cascading classes and '&' support - From: "Jeff 'japhy' Pinyan" <japhy@perlmonk.org> - Date: Wed, 14 Apr 2004 17:01:38 -0400 (EDT) - Message-ID: <Pine.LNX.4.44.0404141659480.11423-301000@perlmonk.org> + [ 23047] + Update tests and $VERSION for change 23046 - [ 22714] - New file left out of the last commit. + plus changes to Deparse.pm from 17682 and 18727. Deparse is now + identical in blead and maint. Branch: maint-5.8/perl - +> t/uni/class.t - !> MANIFEST lib/utf8_heavy.pl pod/perlunicode.pod + ! ext/B/B/Deparse.pm ext/B/defsubs_h.PL + !> ext/B/t/deparse.t ____________________________________________________________________________ -[ 22855] By: nicholas on 2004/05/29 19:39:53 +[ 23290] By: nicholas on 2004/09/09 08:39:31 Log: Integrate: - [ 22806] - Subject: Re: a little extra cmdline help. [PATCH] + [ 22824] + Fix new B::Concise test output + Subject: Re: Smoke [5.9.2] 22820 FAIL(F) openbsd 3.5 (i386/1 cpu) From: Jim Cromie <jcromie@divsol.com> - Date: Mon, 10 May 2004 15:25:07 -0600 - Message-Id: <409FF333.4020104@divsol.com> + Date: Mon, 17 May 2004 09:19:00 -0600 + Message-ID: <40A8D7E4.1020007@divsol.com> + + [ 22825] + Remove a TODO test that is no longer to do. + + [ 22833] + Test portability nit. + Subject: [PATCH] Re: Smoke [5.9.2] 22821 FAIL(F) MSWin32 WinXP/.Net SP1 (x86/1 cpu) + From: Steve Hay <steve.hay@uk.radan.com> + Date: Tue, 18 May 2004 11:31:04 +0100 + Message-ID: <40A9E5E8.7030800@uk.radan.com> + + [ 22951] + If we don't build B, we should skip all its tests. + Branch: maint-5.8/perl + +> ext/B/t/bytecode.t + ! ext/B/t/f_sort.t ext/B/t/optree_samples.t + !> ext/B/t/f_map.t ext/B/t/optree_check.t + !> ext/B/t/optree_concise.t ext/B/t/optree_sort.t + !> ext/B/t/optree_specials.t ext/B/t/optree_varinit.t +____________________________________________________________________________ +[ 23289] By: nicholas on 2004/09/09 06:48:05 + Log: I DO NOT NEED THIS + //depot/maint-5.8/perl/ext/B/t/f_map.t - can't branch (already opened for add) + //depot/maint-5.8/perl/ext/B/t/f_sort.t - can't branch (already opened for add) - [ 22810] - Subject: various -V: searches [PATCH] + (23278 integration redux - the parts that perforce JUST CANNOT DO the + first time) + Branch: maint-5.8/perl + !> ext/B/t/f_map.t ext/B/t/f_sort.t +____________________________________________________________________________ +[ 23288] By: nicholas on 2004/09/09 06:30:32 + Log: Integrate: + [ 22820] + Subject: Re: more B::Concise stuff (PATCH - updated) From: Jim Cromie <jcromie@divsol.com> - Date: Tue, 11 May 2004 00:15:46 -0600 - Message-ID: <40A06F92.1070607@divsol.com> + Date: Mon, 10 May 2004 05:28:11 -0600 + Message-ID: <409F674B.2000506@divsol.com> - [ 22826] - Error message too wide. + [ 23278] + backport B to work on 5.8.x, so that a single version of the source + can be maintained, and ultimately dual-lifed on CPAN + (the version conditional changes are actually surprisingly small) + + (well, except the bits that hateful perforce won't let me integrate + this time round) Branch: maint-5.8/perl - ! lib/Config.t - !> configpm perl.c pod/perlrun.pod + +> ext/B/t/f_map ext/B/t/f_map.t ext/B/t/f_sort ext/B/t/f_sort.t + +> ext/B/t/optree_specials.t + ! ext/B/t/concise.t ext/B/t/showlex.t + !> MANIFEST ext/B/B/Concise.pm ext/B/B/Showlex.pm + !> ext/B/B/Terse.pm ext/B/t/OptreeCheck.pm ext/B/t/optree_check.t + !> ext/B/t/optree_concise.t ext/B/t/optree_samples.t + !> ext/B/t/optree_sort.t ext/B/t/optree_varinit.t ____________________________________________________________________________ -[ 22854] By: nicholas on 2004/05/29 18:22:58 - Log: Revert 22849 and 22851, except for the t/test.pl improvement. - [blead patches 22664 and 22669] +[ 23287] By: nicholas on 2004/09/08 22:14:31 + Log: Integrate: + [ 22354] + Increment the version number of B, due to the incompatible + API change introduced by #22353 (no more op_seq method.) - http://www.perforce.com/perforce/technotes/note014.html - "How do you back out a change?" + [ 22801] + Subject: Re: stdio still supported? + From: Jim Cromie <jcromie@divsol.com> + Date: Thu, 06 May 2004 16:37:56 -0600 + Message-Id: <409ABE44.8060307@divsol.com> - Let me summarise their answer: - With difficulty. - (We find it easier to write a manual about how to kludge it than - to improve our software to make it simple) + Update B::Concise tests to skip stuff requiring the + "open to a scalar" feature of Perlio is it isn't available. + Also note this caveat in perlfunc.pod Branch: maint-5.8/perl - - ext/B/t/OptreeCheck.pm ext/B/t/optree_check.t - - ext/B/t/optree_concise.t ext/B/t/optree_samples.t - - ext/B/t/optree_sort.t ext/B/t/optree_varinit.t - ! MANIFEST ext/B/t/concise.t + ! ext/B/B.pm + !> ext/B/B/Concise.pm ext/B/t/concise.t ext/B/t/optree_check.t + !> ext/B/t/optree_concise.t ext/B/t/optree_samples.t + !> ext/B/t/optree_sort.t ext/B/t/optree_varinit.t + !> pod/perlfunc.pod ____________________________________________________________________________ -[ 22851] By: nicholas on 2004/05/27 10:22:23 +[ 23286] By: nicholas on 2004/09/08 21:58:30 Log: Integrate: [ 22669] Fix command-line quoting under Windows for the new optree tests @@ -1408,7 +1679,7 @@ ____________________________________________________________________________ Branch: maint-5.8/perl !> ext/B/t/optree_samples.t ____________________________________________________________________________ -[ 22849] By: nicholas on 2004/05/26 10:12:38 +[ 23285] By: nicholas on 2004/09/08 21:47:12 Log: Integrate: [ 22664] Subject: Re: tests for change #22539 @@ -1416,380 +1687,332 @@ ____________________________________________________________________________ Date: Tue, 30 Mar 2004 14:39:31 -0700 Message-ID: <4069E913.5040906@divsol.com> (with some spelling tweaks) - - [I'd do this and the next 2 as one, but perforce is hateful: - http://nick.hates-software.com/2003/12/30/9729c0ac.html - ] Branch: maint-5.8/perl +> ext/B/t/OptreeCheck.pm ext/B/t/optree_check.t +> ext/B/t/optree_concise.t ext/B/t/optree_samples.t +> ext/B/t/optree_sort.t ext/B/t/optree_varinit.t - ! ext/B/t/concise.t - !> MANIFEST ext/B/B/Concise.pm t/test.pl -____________________________________________________________________________ -[ 22847] By: nicholas on 2004/05/25 21:27:12 - Log: Integrate: - [ 22839] - [perl #29790] Optimization busted: '@a = "b", sort @a' drops "b" - Fix the sort-in-place optimization of change #22349. - Branch: maint-5.8/perl - !> op.c t/op/sort.t + !> MANIFEST ext/B/B/Concise.pm ext/B/t/concise.t ____________________________________________________________________________ -[ 22846] By: nicholas on 2004/05/25 20:56:06 +[ 23284] By: nicholas on 2004/09/08 20:50:55 Log: Integrate: - [ 22808] - Subject: [PATCH] debugger (step backwards) - From: Richard.Foley@t-online.de (Richard Foley) - Date: Tue, 11 May 2004 11:04:11 +0200 - Message-Id: <200405111104.11484.richard.foley@rfi.net> - [ 22809] - More pod names in the debugger for the runman command - Branch: maint-5.8/perl - !> lib/perl5db.pl -____________________________________________________________________________ -[ 22845] By: nicholas on 2004/05/25 20:54:05 - Log: Integrate: - [ 22788] - add -pipe to gcc's default flags - it has shown a compile time speed increase of about 40% on - Linux and HP-UX, and also works on cygwin-1.5.9. On failing - OS/gcc combo's remove it in the hints + (the parts of the first that affect ext/B/... and the parts of the + second that related to changes in 22353) - [ 22815] - Subject: [PATCH] Configure shouldn't unconditionally add in -pipe - From: Andy Dougherty <doughera@lafayette.edu> - Date: Tue, 11 May 2004 13:14:42 -0400 (EDT) - Message-ID: <Pine.SOL.4.58.0405111313210.14279@maxwell.phys.lafayette.edu> - Branch: maint-5.8/perl - !> Configure hints/darwin.sh hints/rhapsody.sh -____________________________________________________________________________ -[ 22844] By: nicholas on 2004/05/24 16:42:34 - Log: Update changes - Branch: maint-5.8/perl - ! Changes patchlevel.h -____________________________________________________________________________ -[ 22834] By: nicholas on 2004/05/20 13:13:45 - Log: Integrate: - [ 22827] - Subject: [PATCH] Re: Smoke [5.9.2] 22818 FAIL(F) MSWin32 WinXP/.Net SP1 (x86/1 cpu) - From: Steve Hay <steve.hay@uk.radan.com> - Date: Fri, 14 May 2004 17:33:17 +0100 - Message-ID: <40A4F4CD.2000003@uk.radan.com> - Branch: maint-5.8/perl - !> t/comp/utf.t -____________________________________________________________________________ -[ 22832] By: nicholas on 2004/05/20 08:18:58 - Log: Integrate: - [ 22818] - Subject: BOM-marked and (BOMless) UTF-16 scripts not working - From: Jarkko Hietaniemi <jhi@iki.fi> - Message-ID: <40A26D75.8080406@iki.fi> - Date: Wed, 12 May 2004 21:31:17 +0300 - Branch: maint-5.8/perl - +> t/comp/utf.t - !> MANIFEST pod/perldiag.pod pod/perlunicode.pod toke.c -____________________________________________________________________________ -[ 22813] By: nicholas on 2004/05/12 10:16:45 - Log: (only the fix, not the tests, as they incorporate the variable names) + [ 22353] + Subject: Re: op_seq (was: Freeing code) + From: Paul Johnson <paul@pjcj.net> + Date: Sat, 21 Feb 2004 02:31:47 +0100 + Message-ID: <20040221013147.GB6953@pjcj.net> - Integrate: - [ 22796] - [perl #29346] Double warning for int(undef) and abs(undef) - Remove the duplicate warnings and update tests. + Rework the OP structure to use less space. + Remove op_seq (and simulate it in dump.c), + replace it by op_opt and op_static, + shrink op_type, remove PL_op_seqmax. + + [ 23278] + backport B to work on 5.8.x, so that a single version of the source + can be maintained, and ultimately dual-lifed on CPAN + (the version conditional changes are actually surprisingly small) Branch: maint-5.8/perl - !> pp.c + ! ext/B/B.xs ext/B/B/C.pm ext/B/B/Concise.pm + !> ext/B/B/Debug.pm ext/B/t/stash.t ____________________________________________________________________________ -[ 22805] By: nicholas on 2004/05/10 21:22:15 +[ 23273] By: nicholas on 2004/09/05 22:06:51 Log: Integrate: - [ 22797] - Document that select() on Windows doesn't work on non-socket filehandles. + [ 23232] + Upgrade to Time::HiRes 1.61 + + [ 23237] + Upgrade to MIME::Base64 3.02. - [ 22799] - Subject: [perl #29397] Change in pod2man arguments - From: Thorsten Glaser (via RT) <perlbug-followup@perl.org> - Date: 6 May 2004 22:08:10 -0000 - Message-Id: <rt-3.0.9-29397-86929.5.37563386041974@perl.org> + [ 23238] + Upgrade to MIME::Base64 3.03 - [ 22800] - Windows issues with select() are already documented in perlport. + [ 23241] + Subject: [PATCH] File::Spec::VMS update + From: "Craig A. Berry" <craigberry@mac.com> + Date: Fri, 27 Aug 2004 18:51:09 -0500 + Message-ID: <412FC8ED.1020300@mac.com> + + [ 23247] + Update to File::Spec 0.90 - [ 22803] - Subject: [PATCH] File::Copy Pod - From: slaven@rezic.de - Date: Mon, 10 May 2004 09:57:37 +0000 - Message-Id: <1084183057.10822@devpc01.iconmobile.de> + [ 23248] + Upgrade to Cwd 2.21. - [ 22804] - Remove stray '. + [ 23258] + Upgrade to Encode 2.02 Branch: maint-5.8/perl - !> lib/File/Copy.pm pod/perlfunc.pod pod/pod2man.PL + !> (integrate 28 files) ____________________________________________________________________________ -[ 22795] By: nicholas on 2004/05/06 16:06:17 +[ 23272] By: nicholas on 2004/09/05 21:47:13 Log: Integrate: - [ 22696] - #24121: Configure under turkish locale fails - toupper (i) != I in turkish, but U+0130 - \N{LATIN CAPITAL LETTER I WITH DOT ABOVE} - Patch supplied by Rafael - - [ 22743] - usemallocwrap works on AIX, but not with vac-5 - Date: Mon, 26 Apr 2004 15:35:23 +0200 - From: "H.Merijn Brand" <h.m.brand@hccnet.nl> - Subject: Re: Perl 5.8.4 "panic: memory wrap" in miniperl on AIX 5.1 - Message-Id: <20040426152951.A6C4.H.M.BRAND@hccnet.nl> - - [ 22750] - When configuring for 64-bit support, check that the - C library functions for casting floating point values - to 64-bit integer values are not broken. - - [ 22752] - The openbsd 64-bit test should use $uquadtype rather - than hardcoding unsigned long long. + [ 23194] + Subject: Re: POSIX::sigprocmask implemented incorrectly + From: Alan Burlison <Alan.Burlison@sun.com> + Date: Mon, 19 Jul 2004 12:07:02 +0100 + Message-ID: <40FBAB56.1030208@sun.com> - [ 22753] - CXUX_BROKEN_CONSTANT_CONVERT isn't used anymore. - Remove all associated code. + (last chunk only) - [ 22759] - mktables requires post 5.005 + [ 23204] + Subject: Re: POSIX::sigprocmask implemented incorrectly + From: Alan Burlison <Alan.Burlison@sun.com> + Date: Mon, 09 Aug 2004 10:30:25 +0100 + Message-ID: <41174431.6050803@sun.com> - [ 22773] - Subject: Re: "fuzzy" in mktables - From: Jarkko Hietaniemi <jhi@iki.fi> - Message-ID: <4093A82B.6040609@iki.fi> - Date: Sat, 01 May 2004 16:37:47 +0300 + [ 23211] + Subject: Re: POSIX::sigprocmask implemented incorrectly + From: Alan Burlison <Alan.Burlison@sun.com> + Date: Mon, 09 Aug 2004 19:00:12 +0100 + Message-ID: <4117BBAC.7080603@sun.com> Branch: maint-5.8/perl - !> Configure hints/aix.sh hints/aix_4.sh hints/cxux.sh - !> hints/openbsd.sh lib/unicore/mktables pp_pack.c + !> ext/POSIX/POSIX.xs ____________________________________________________________________________ -[ 22794] By: nicholas on 2004/05/06 15:43:41 +[ 23270] By: nicholas on 2004/09/05 21:34:19 Log: Integrate: - [ 22681] - find2perl should not default to -print when -eval is specified. - Noticed by David Dyck. + [ 23175] + Fix copy & paste bugs in mX?PUSH macro tests. - [ 22733] - Missing copyright in the README. + [ 23203] + Add tests for XS call_*() API + Branch: maint-5.8/perl + +> ext/XS/APItest/t/call.t + !> MANIFEST ext/XS/APItest/APItest.pm ext/XS/APItest/APItest.xs + !> ext/XS/APItest/MANIFEST pod/perlcall.pod +____________________________________________________________________________ +[ 23269] By: nicholas on 2004/09/05 21:03:20 + Log: Integrate: + [ 23223] + Upgrade to Devel::PPPort 3.00_01. + + [ 23226] + Upgrade to Devel::PPPort 3.00_02. + + [ 23229] + Upgrade to Devel::PPPort 3.00_03. + + [ 23234] + Upgrade to Devel::PPPort 3.01. + Branch: maint-5.8/perl + +> ext/Devel/PPPort/parts/inc/sv_xpvf ext/Devel/PPPort/t/cop.t + +> ext/Devel/PPPort/t/sv_xpvf.t + !> MANIFEST ext/Devel/PPPort/Changes ext/Devel/PPPort/MANIFEST + !> ext/Devel/PPPort/META.yml ext/Devel/PPPort/Makefile.PL + !> ext/Devel/PPPort/PPPort.pm ext/Devel/PPPort/PPPort.xs + !> ext/Devel/PPPort/PPPort_pm.PL ext/Devel/PPPort/TODO + !> ext/Devel/PPPort/module2.c ext/Devel/PPPort/parts/apicheck.pl + !> ext/Devel/PPPort/parts/inc/misc + !> ext/Devel/PPPort/parts/inc/ppphbin + !> ext/Devel/PPPort/parts/inc/ppphtest + !> ext/Devel/PPPort/parts/inc/uv + !> ext/Devel/PPPort/parts/inc/version + !> ext/Devel/PPPort/parts/ppptools.pl + !> ext/Devel/PPPort/parts/todo/5004000 + !> ext/Devel/PPPort/parts/todo/5004050 + !> ext/Devel/PPPort/parts/todo/5006000 + !> ext/Devel/PPPort/t/ppphtest.t ext/Devel/PPPort/t/uv.t +____________________________________________________________________________ +[ 23268] By: nicholas on 2004/09/05 20:48:03 + Log: Integrate: + [ 22535] + Move Beau Cox's ppport.h fixes into PPPort.pm + + [ 23222] + Upgrade to Devel::PPPort 3.00. + Branch: maint-5.8/perl + +> (branch 103 files) + - ext/Devel/PPPort/t/test.t + !> MANIFEST ext/Devel/PPPort/Changes ext/Devel/PPPort/MANIFEST + !> ext/Devel/PPPort/Makefile.PL ext/Devel/PPPort/PPPort.pm + !> ext/Devel/PPPort/PPPort.xs ext/Devel/PPPort/README + !> ext/Devel/PPPort/TODO ext/Devel/PPPort/module2.c + !> ext/Devel/PPPort/module3.c ext/Devel/PPPort/ppport_h.PL + !> ext/Devel/PPPort/soak +____________________________________________________________________________ +[ 23265] By: nicholas on 2004/09/05 19:50:28 + Log: Integrate: + [ 23142] + Subject: [perl #30609] [PATCH] BigInt v1.71 - first try + From: Tels <perl_dummy@bloodgate.com> + Date: Sat, 17 Jul 2004 16:22:57 +0200 + Message-Id: <200407171622.58443@bloodgate.com> + + [ 23152] + Upgrade to Cwd 2.20 + + [ 23168] + Upgrade to File::Spec 0.88. + + [ 23171] + Upgrade to Math::BigInt v1.71. + + [ 23202] + Subject: [PATCH] DB_File 1.810 + From: "Paul Marquess" <Paul.Marquess@btinternet.com> + Date: Sat, 7 Aug 2004 15:22:09 +0100 + Message-Id: <20040807142059.CTQC10838.mta10-svc.ntlworld.com@MARQUESSPT21> + Branch: maint-5.8/perl + +> ext/Cwd/t/win32.t + ! lib/Math/BigInt.pm + !> MANIFEST ext/Cwd/Changes ext/Cwd/Cwd.xs ext/Cwd/t/cwd.t + !> ext/DB_File/Changes ext/DB_File/DB_File.pm + !> ext/DB_File/DB_File.xs ext/DB_File/t/db-hash.t lib/Cwd.pm + !> lib/File/Spec.pm lib/File/Spec/Win32.pm lib/File/Spec/t/Spec.t + !> lib/Math/BigFloat.pm lib/Math/BigInt/Calc.pm + !> lib/Math/BigInt/t/bare_mbf.t lib/Math/BigInt/t/bare_mbi.t + !> lib/Math/BigInt/t/bigfltpm.inc lib/Math/BigInt/t/bigfltpm.t + !> lib/Math/BigInt/t/bigintpm.inc lib/Math/BigInt/t/bigintpm.t + !> lib/Math/BigInt/t/sub_mbf.t lib/Math/BigInt/t/sub_mbi.t + !> lib/Math/BigInt/t/with_sub.t +____________________________________________________________________________ +[ 23264] By: nicholas on 2004/09/05 18:42:01 + Log: Integrate: + [ 23092] + Subject: Re: [perl #30568] splice generates undef? [PATCH] + From: LAUN Wolfgang <wolfgang.laun@alcatel.at> + Date: Mon, 12 Jul 2004 08:26:01 +0200 + Message-ID: <DF27CDCBD2581D4B88431901094E4B4D02B0C7D2@attmsx1.aut.alcatel.at> - [ 22735] - Subject: [PATCH] Where to find nmake for windows - From: Abe Timmerman <abe@ztreet.demon.nl> - Date: Thu, 22 Apr 2004 23:57:40 +0200 - Message-Id: <200404222357.40508.abe@ztreet.demon.nl> - Changed download URL references for nmake - - [ 22747] - Subject: [perl #29033] typo in description of sleep in documentation of POSIX module - Date: 21 Apr 2004 11:07:22 -0000 - From: "bob@starlabs.net (via RT)" <perlbug-followup@perl.org> - Message-ID: <rt-3.0.8-29033-85811.17.0452776199501@perl.org> - - [ 22748] - Subject: [PATCH] Add diagnostics section to base.pm - From: "Jos I. Boumans" <kane@dwim.org> - Date: Wed, 28 Apr 2004 13:04:47 +0200 - Message-Id: <DC9B4A9C-9903-11D8-BA95-000A956B0E06@dwim.org> + [ 23145] + Subject: [PATCH perl-current] Re: [perl #30688] Empty slice arg with ($;$) prototype + From: Rick Delaney <rick@bort.ca> + Date: Tue, 20 Jul 2004 16:53:54 -0400 + Message-ID: <20040720205353.GA970@biff.bort.ca> - [ 22749] - Fix for [perl #28963]: find2perl was sometimes generating - invalid code. + [ 23177] + shut up a warning in mg.c - [ 22768] - It seems daft to me that we have a synopis example that will fail if - gcc happened to be invoked via the name cc, and completely ignores - the far more reliable 'gccversion' variable - So here's one using 'usethreads' that ought to work everywhere. + [ 23178] + Remove redundant SvOOK_off (called implicitly by SvOK_off) + and merge identical cases. - [ 22782] - Subject: Problem with h2xs - From: David Cannings <lists@edeca.net> - Date: Mon, 3 May 2004 13:44:33 +0100 - Message-Id: <200405031344.33723.lists@edeca.net> - (Second patch only) + [ 23213] + Subject: Re: 2 patches: goto.t, B.pm/xs + From: Jim Cromie <jcromie@divsol.com> + Date: Tue, 10 Aug 2004 07:29:08 -0600 + Message-ID: <4118CDA4.3060700@divsol.com> - [ 22789] - Subject: Problem with system() on Win9x and command.com (perl 5.8.x-5.9.x) - From: bilbo@ua.fm - Date: Wed, 28 Apr 2004 00:19:55 +0300 - Message-ID: <611491036.20040428001955@ua.fm> + [ 23217] + make pp_goto() cope potential stack reallocation in EXTEND + The code for goto &foo had local pointers to the stack that + pointed to the wrong place after a realloc. - [ 22793] - Add a small script to check whether a perl source tree - (with or without generated files) is friendly with - case-insensitive filesystems. - Adapted from : - Subject: Re: STerm.pl vs Sterm.pl - From: James Mastros <james@mastros.biz> - Date: Thu, 06 May 2004 14:45:53 +0200 - Message-ID: <20040506124556.2402.qmail@onion.perl.org> - Branch: maint-5.8/perl - +> Porting/checkcase.pl - !> MANIFEST README README.win32 configpm ext/POSIX/POSIX.pod - !> lib/base.pm pod/perlmodinstall.pod utils/h2xs.PL win32/win32.c - !> x2p/find2perl.PL -____________________________________________________________________________ -[ 22792] By: nicholas on 2004/05/06 14:15:56 - Log: Integrate: - [ 22715] - Upgrade to FileCache 1.04. + [ 23230] + a regex in STDOUT destructor coredumped because regex pad already + freed + + [ 23235] + Subject: [perl #31295] PATCH: Test comp/use.t fails on Tru64 + From: Nikola Milutinovic (via RT) <perlbug-followup@perl.org> + Date: 23 Aug 2004 10:37:31 -0000 + Message-ID: <rt-3.0.11-31295-94232.1.74127465250315@perl.org> - [ 22717] - Subject: [PATCH] Sync Term::Cap with CPAN version - From: Jonathan Stowe <jns@gellyfish.com> - Date: Tue, 20 Apr 2004 12:37:28 +0100 - Message-Id: <1082461047.2736.96.camel@localhost> + [ 23251] + [perl #31111] Random made scripts crashing perl + fix 'formline undef' coredump - [ 22751] - Update to Test.pm 1.25 (from SBURKE). + [ 23252] + delete spurious blank lines added by change 23251 Branch: maint-5.8/perl - +> lib/Test/t/05_about_verbose.t lib/Test/t/multiline.t - !> MANIFEST lib/FileCache.pm lib/Term/Cap.pm lib/Test.pm + !> mg.c perl.c pp.c pp_ctl.c scope.c t/comp/use.t t/op/goto.t + !> t/op/list.t t/op/ref.t t/op/splice.t ____________________________________________________________________________ -[ 22791] By: nicholas on 2004/05/06 13:55:34 +[ 23263] By: nicholas on 2004/09/05 08:30:36 Log: Integrate: - [ 21935] - Upgrade to Time::Local 1.07_94 - - [ 22670] - Disable the edge case tests for timegm and timelocal on - AIX-4.3 since the OS is obsoleted, and fixes are not to - be expected + [ 23090] + no_plan support in test.pl - [ 22671] - Integrated Time-Local-1.09 from Dave Rolsky - Corrected a wrap error from the CPAN version to match #22670 - Tested on AIX to make sure the skip is still needed + [ 23208] + made eq_array in t/test.pl handle undef values better Branch: maint-5.8/perl - !> lib/Time/Local.pm lib/Time/Local.t + !> t/test.pl ____________________________________________________________________________ -[ 22790] By: nicholas on 2004/05/06 13:36:23 +[ 23262] By: nicholas on 2004/09/05 08:11:31 Log: Integrate: - [ 22686] - Sync with libnet 1.18 + [ 23089] + Subject: Re: debugger 'R'estart and open database connections + From: Andrew Pimlott <andrew@pimlott.net> + Date: Mon, 12 Jul 2004 21:06:01 -0400 + Message-ID: <20040713010601.GF8232@pimlott.net> - (plus revert the relevant parts of 22643) + [ 23095] + Tweak to change #23089, as suggested by Tim Bunce Branch: maint-5.8/perl - +> lib/Net/Changes.libnet lib/Net/t/datasend.t - - lib/Net/ChangeLog.libnet - ! lib/Net/NNTP.pm lib/Net/POP3.pm lib/Net/SMTP.pm - !> MANIFEST lib/Net/Cmd.pm lib/Net/FTP.pm lib/Net/README.libnet - !> lib/Net/Time.pm lib/Net/t/hostname.t + !> lib/perl5db.pl ____________________________________________________________________________ -[ 22785] By: nicholas on 2004/05/06 08:16:42 - Log: Fix typo +[ 23261] By: nicholas on 2004/09/04 20:30:30 + Log: Integrate: + [ 23074] + Subject: Re: Segfault using HTML::Entities + From: Jarkko Hietaniemi <jhi@iki.fi> + Message-ID: <40EDBE1A.6080205@iki.fi> + Date: Fri, 09 Jul 2004 00:35:22 +0300 Branch: maint-5.8/perl - ! MANIFEST + !> pp_ctl.c regexec.c t/run/fresh_perl.t ____________________________________________________________________________ -[ 22784] By: nicholas on 2004/05/05 21:43:32 +[ 23260] By: nicholas on 2004/09/04 20:18:50 Log: Integrate: - [ 22641] - Fix bug #27940 : \cX escapes weren't working correctly in regular - expression ranges. - - [ 22652] - Subject: sv_pvutf8n_force and sv_pvbyten_force - From: SADAHIRO Tomoyuki <bqw10602@nifty.com> - Date: Wed, 24 Mar 2004 00:16:52 +0900 - Message-Id: <20040324001126.098F.BQW10602@nifty.com> - - [ 22667] - The optree builder was looping when constructing the ops - for a map/grep block containing a while(1). - (Bug reported by Pixel.) - - [ 22687] - Make global cleanup fractionally faster by giving S_visit() - flags/mask to compare SVs against. - - [ 22712] - Subject: Re: [perl #28532] optional match of an anchor gets ignored - From: hv@crypt.org - Date: Wed, 14 Apr 2004 19:30:46 +0100 - Message-Id: <200404141830.i3EIUko03728@zen.crypt.org> - - [ 22721] - Subject: [patch] log the interpreter id in warnings - From: Stas Bekman <stas@stason.org> - Date: Mon, 19 Apr 2004 18:10:01 -0700 - Message-ID: <40847869.1000906@stason.org> - - [ 22746] - fix a coredump caused by rv2gv not fully converting a PV to an RV - - [ 22755] - Fix 29149 - another UTF8 cache bug hit by substr. - Regression test from: - - Subject: Re: [perl #29149] substr/UTF8 related problem with perl 5.8.3 on linux - From: SADAHIRO Tomoyuki <bqw10602@nifty.com> - Message-Id: <20040429103926.5BA6.BQW10602@nifty.com> - Date: Thu, 29 Apr 2004 10:53:17 +0900 - - [ 22764] - Save some repeated strlen()s in Perl_swash_init - - [ 22774] - [perl #28938] split could leave an array without &PL_sv_undef - in the unused elements - - [ 22775] - [perl #29127] scalar delete of empty slice returned garbage - - [ 22776] - [perl #28986] perl -e "open m" crashes Perl - - [ 22777] - add test for change #22776 ("open m" crashes Perl) + [ 22997] + Cleanup the main regex in Text::ParseWords and make the + parse_line() routine faster. Add a Unicode test case. - [ 22778] - add test for change #22746 ([perl #29102] Crash on assign to lex fh) + [ 23060] + Failing matches don't reset numbered variables. + Change #22997 could cause Text::ParseWords to loop forever if the + regex didn't not match. Explicitly return if the match fails. + Branch: maint-5.8/perl + !> lib/Text/ParseWords.pm lib/Text/ParseWords.t +____________________________________________________________________________ +[ 23259] By: nicholas on 2004/09/04 19:40:24 + Log: Integrate: + [ 22969] + Abolish the "Tied variable freed while still in use" error - I have + a way to cleanly avoid the coredump. - [ 22781] - [perl #29340] Bizarre copy of ARRAY - make sure a pad op's flags are updated after optimising away - the assignment in my @a = () (see change 22520). + [ 23040] + t/op/tie.t test 23 is failing when run with utf8 everywhere. + Problem appears to be due to theft of temporaries Branch: maint-5.8/perl - ! t/op/substr.t - !> embed.fnc embed.h gv.c handy.h hv.c op.c perl.c pp.c proto.h - !> regcomp.c regexec.c sv.c t/io/open.t t/op/delete.t t/op/grep.t - !> t/op/my.t t/op/pat.t t/op/split.t toke.c utf8.c + !> mg.c pod/perldiag.pod t/op/tie.t ____________________________________________________________________________ -[ 22766] By: nicholas on 2004/05/02 20:26:29 - Log: Ready for more Changes +[ 23169] By: nicholas on 2004/07/29 22:05:16 + Log: Integrate: + [ 23058] + Stop ENV_IS_CASELESS hv.c picking up the wrong hash value from a + shared string scalar. + + [ 23061] + hv_store was not passing hash onwards (spotted by Dave) Branch: maint-5.8/perl - +> Changes5.8.4 - ! Changes MANIFEST + !> hv.c ____________________________________________________________________________ -[ 22740] By: nicholas on 2004/04/23 14:14:11 - Log: Subject: [PATCH] unfork the debugger (patch for 5.8.4) - From: Richard.Foley@t-online.de (Richard Foley) - Message-Id: <200404230633.29186.richard.foley@rfi.net> - Date: Fri, 23 Apr 2004 06:33:29 +0200 +[ 23153] By: nicholas on 2004/07/22 17:05:37 + Log: Create pod/perl586delta.pod Branch: maint-5.8/perl - ! lib/perl5db.pl + +> pod/perl586delta.pod + ! MANIFEST Makefile.SH pod.lst pod/perl.pod pod/perl585delta.pod + ! pod/perltoc.pod vms/descrip_mms.template win32/Makefile + ! win32/makefile.mk win32/pod.mak ____________________________________________________________________________ -[ 22738] By: nicholas on 2004/04/23 13:13:24 - Log: Create perl585delta.pod +[ 23144] By: nicholas on 2004/07/20 16:39:42 + Log: Typo spotted by Jarkko. (But not by ispell, as it was another valid + word) Branch: maint-5.8/perl - + pod/perl585delta.pod - ! MANIFEST pod.lst pod/perl.pod pod/perltoc.pod - ! vms/descrip_mms.template win32/Makefile win32/makefile.mk - ! win32/pod.mak + ! pod/perl585delta.pod ____________________________________________________________________________ -[ 22732] By: nicholas on 2004/04/22 09:21:28 - Log: That was 5.8.4 +[ 23143] By: nicholas on 2004/07/19 21:51:18 + Log: Disarm the maint branch Branch: maint-5.8/perl ! patchlevel.h ____________________________________________________________________________ -[ 22731] By: nicholas on 2004/04/21 19:37:51 - Log: Oink, oink, flap, flap! +[ 23141] By: nicholas on 2004/07/19 14:25:58 + Log: Break a leg Branch: maint-5.8/perl ! patchlevel.h pod/perlhist.pod ____________________________________________________________________________ -[ 22730] By: nicholas on 2004/04/21 18:55:58 +[ 23140] By: nicholas on 2004/07/19 14:06:59 Log: Update Changes Branch: maint-5.8/perl ! Changes patchlevel.h diff --git a/gnu/usr.bin/perl/Configure b/gnu/usr.bin/perl/Configure index 1b4c5cf91a6..54d41b05b23 100644 --- a/gnu/usr.bin/perl/Configure +++ b/gnu/usr.bin/perl/Configure @@ -18,9 +18,9 @@ # you may fetch it yourself from your nearest archive site.) # -# $Id: Configure,v 1.15 2004/08/14 00:12:22 millert Exp $ +# $Id: Configure,v 1.16 2004/08/15 20:57:29 millert Exp $ # -# Generated on Wed May 12 13:00:30 METDST 2004 [metaconfig 3.0 PL70] +# Generated on Fri Jul 16 12:49:13 METDST 2004 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.org) cat >c1$$ <<EOF @@ -91,7 +91,7 @@ paths="$paths /opt/bin /opt/local/bin /opt/local /opt/lbin" paths="$paths /usr/5bin /etc /usr/gnu/bin /usr/new /usr/new/bin /usr/nbin" paths="$paths /opt/gnu/bin /opt/new /opt/new/bin /opt/nbin" paths="$paths /sys5.3/bin /sys5.3/usr/bin /bsd4.3/bin /bsd4.3/usr/ucb" -paths="$paths /bsd4.3/usr/bin /usr/bsd /bsd43/bin /usr/ccs/bin" +paths="$paths /bsd4.3/usr/bin /usr/bsd /bsd43/bin /opt/ansic/bin /usr/ccs/bin" paths="$paths /etc /usr/lib /usr/ucblib /lib /usr/ccs/lib" paths="$paths /sbin /usr/sbin /usr/libexec" paths="$paths /system/gnu_library/bin" @@ -3080,7 +3080,9 @@ EOM aix) osname=aix tmp=`( (oslevel) 2>/dev/null || echo "not found") 2>&1` case "$tmp" in - 'not found') osvers="$4"."$3" ;; + # oslevel can fail with: + # oslevel: Unable to acquire lock. + *not\ found) osvers="$4"."$3" ;; '<3240'|'<>3240') osvers=3.2.0 ;; '=3240'|'>3240'|'<3250'|'<>3250') osvers=3.2.4 ;; '=3250'|'>3250') osvers=3.2.5 ;; diff --git a/gnu/usr.bin/perl/INSTALL b/gnu/usr.bin/perl/INSTALL index 217de57fe85..886bf54b544 100644 --- a/gnu/usr.bin/perl/INSTALL +++ b/gnu/usr.bin/perl/INSTALL @@ -657,6 +657,19 @@ architecture-dependent library for your -DDEBUGGING version of perl. You can do this by changing all the *archlib* variables in config.sh to point to your new architecture-dependent library. +=head3 Environment access + +Perl often needs to write to the program's environment, such as when C<%ENV> +is assigned to. Many implementations of the C library function C<putenv()> +leak memory, so where possible perl will manipulate the environment directly +to avoid these leaks. The default is now to perform direct manipulation +whenever perl is running as a stand alone interpreter, and to call the safe +but potentially leaky C<putenv()> function when the perl interpreter is +embedded in another application. You can force perl to always use C<putenv()> +by compiling with -DPERL_USE_SAVE_PUTENV. You can force an embedded perl to +use direct manipulation by setting C<PL_use_safe_putenv = 0;> after the +C<perl_construct()> call. + =head2 Installation Directories The installation directories can all be changed by answering the @@ -1677,13 +1690,33 @@ to then propagate your changes with B<sh Configure -S> and rebuild with B<make depend; make>. -=item Missing functions +=item Missing functions and Undefined symbols + +If the build of miniperl fails with a long list of missing functions or +undefined symbols, check the libs variable in the config.sh file. It +should look something like + + libs='-lsocket -lnsl -ldl -lm -lc' + +The exact libraries will vary from system to system, but you typically +need to include at least the math library -lm. Normally, Configure +will suggest the correct defaults. If the libs variable is empty, you +need to start all over again. Run + + make distclean + +and start from the very beginning. This time, unless you are sure of +what you are doing, accept the default list of libraries suggested by +Configure. + +If the libs variable looks correct, you might have the +L<"nm extraction"> problem discussed above. -If you have missing routines, you probably need to add some library or -other, or you need to undefine some feature that Configure thought was -there but is defective or incomplete. Look through config.h for -likely suspects. If Configure guessed wrong on a number of functions, -you might have the L<"nm extraction"> problem discussed above. +If you stil have missing routines or undefined symbols, you probably +need to add some library or other, or you need to undefine some feature +that Configure thought was there but is defective or incomplete. If +you used a hint file, see if it has any relevant advice. You can also +look through through config.h for likely suspects. =item toke.c diff --git a/gnu/usr.bin/perl/MANIFEST b/gnu/usr.bin/perl/MANIFEST index f561fc6859d..d650126403f 100644 --- a/gnu/usr.bin/perl/MANIFEST +++ b/gnu/usr.bin/perl/MANIFEST @@ -23,6 +23,7 @@ Changes5.8.1 Differences between 5.8.0 and 5.8.1 Changes5.8.2 Differences between 5.8.1 and 5.8.2 Changes5.8.3 Differences between 5.8.2 and 5.8.3 Changes5.8.4 Differences between 5.8.3 and 5.8.4 +Changes5.8.5 Differences between 5.8.4 and 5.8.5 config_h.SH Produces config.h configpm Produces lib/Config.pm Configure Portability tool @@ -114,12 +115,24 @@ ext/B/t/asmdata.t See if B::Asmdata works ext/B/t/assembler.t See if B::Assembler, B::Disassembler comply ext/B/t/bblock.t See if B::Bblock works ext/B/t/b.t See if B works +ext/B/t/bytecode.t See whether B::Bytecode works ext/B/t/concise.t See whether B::Concise works ext/B/t/debug.t See if B::Debug works ext/B/t/deparse.t See if B::Deparse works ext/B/TESTS Compiler backend test data +ext/B/t/f_map code from perldoc -f map +ext/B/t/f_map.t converted to optreeCheck()s +ext/B/t/f_sort optree test raw material +ext/B/t/f_sort.t optree test raw material ext/B/t/lint.t See if B::Lint works ext/B/Todo Compiler backend Todo list +ext/B/t/OptreeCheck.pm optree comparison tool +ext/B/t/optree_check.t test OptreeCheck apparatus +ext/B/t/optree_concise.t more B::Concise tests +ext/B/t/optree_samples.t various basic codes: if for while +ext/B/t/optree_sort.t inplace sort optimization regression +ext/B/t/optree_specials.t BEGIN, END, etc code +ext/B/t/optree_varinit.t my,our,local var init optimization ext/B/t/o.t See if O works ext/B/t/showlex.t See if B::ShowLex works ext/B/t/stash.t See if B::Stash works @@ -138,6 +151,7 @@ ext/Cwd/Cwd.xs Cwd extension external subroutines ext/Cwd/Makefile.PL Cwd extension makefile maker ext/Cwd/t/cwd.t See if Cwd works ext/Cwd/t/taint.t See if Cwd works with taint +ext/Cwd/t/win32.t See if Cwd works on Win32 ext/Data/Dumper/Changes Data pretty printer, changelog ext/Data/Dumper/Dumper.pm Data pretty printer, module ext/Data/Dumper/Dumper.xs Data pretty printer, externals @@ -170,18 +184,123 @@ ext/Devel/Peek/Makefile.PL Data debugging tool, makefile writer ext/Devel/Peek/Peek.pm Data debugging tool, module and pod ext/Devel/Peek/Peek.xs Data debugging tool, externals ext/Devel/Peek/t/Peek.t See if Devel::Peek works +ext/Devel/PPPort/apicheck_c.PL Devel::PPPort apicheck generator ext/Devel/PPPort/Changes Devel::PPPort changes +ext/Devel/PPPort/devel/buildperl.pl Devel::PPPort perl version builder +ext/Devel/PPPort/devel/mkapidoc.sh Devel::PPPort apidoc collector +ext/Devel/PPPort/devel/mktodo Devel::PPPort baseline/todo generator +ext/Devel/PPPort/devel/mktodo.pl Devel::PPPort baseline/todo generator +ext/Devel/PPPort/devel/scanprov Devel::PPPort provided API scanner +ext/Devel/PPPort/HACKERS Devel::PPPort hackers documentation ext/Devel/PPPort/Makefile.PL Devel::PPPort makefile writer ext/Devel/PPPort/MANIFEST Devel::PPPort Manifest +ext/Devel/PPPort/MANIFEST.SKIP Devel::PPPort Manifest skip specs +ext/Devel/PPPort/META.yml Devel::PPPort meta-data in YAML +ext/Devel/PPPort/mktests.PL Devel::PPPort test file writer ext/Devel/PPPort/module2.c Devel::PPPort test file ext/Devel/PPPort/module3.c Devel::PPPort test file -ext/Devel/PPPort/ppport_h.PL Devel::PPPort -ext/Devel/PPPort/PPPort.pm Devel::PPPort -ext/Devel/PPPort/PPPort.xs Devel::PPPort +ext/Devel/PPPort/parts/apicheck.pl Devel::PPPort apicheck generator +ext/Devel/PPPort/parts/apidoc.fnc Devel::PPPort Perl API listing +ext/Devel/PPPort/parts/base/5004000 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5004010 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5004020 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5004030 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5004040 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5004050 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5005000 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5005010 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5005020 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5005030 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5005040 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5006000 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5006001 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5006002 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5007000 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5007001 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5007002 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5007003 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5008000 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5008001 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5008002 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5008003 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5008004 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5008005 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5009000 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5009001 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/base/5009002 Devel::PPPort baseline todo file +ext/Devel/PPPort/parts/embed.fnc Devel::PPPort Perl API listing +ext/Devel/PPPort/parts/inc/call Devel::PPPort include +ext/Devel/PPPort/parts/inc/cop Devel::PPPort include +ext/Devel/PPPort/parts/inc/format Devel::PPPort include +ext/Devel/PPPort/parts/inc/grok Devel::PPPort include +ext/Devel/PPPort/parts/inc/limits Devel::PPPort include +ext/Devel/PPPort/parts/inc/magic Devel::PPPort include +ext/Devel/PPPort/parts/inc/misc Devel::PPPort include +ext/Devel/PPPort/parts/inc/mPUSH Devel::PPPort include +ext/Devel/PPPort/parts/inc/MY_CXT Devel::PPPort include +ext/Devel/PPPort/parts/inc/newCONSTSUB Devel::PPPort include +ext/Devel/PPPort/parts/inc/newRV Devel::PPPort include +ext/Devel/PPPort/parts/inc/ppphbin Devel::PPPort include +ext/Devel/PPPort/parts/inc/ppphdoc Devel::PPPort include +ext/Devel/PPPort/parts/inc/ppphtest Devel::PPPort include +ext/Devel/PPPort/parts/inc/SvPV Devel::PPPort include +ext/Devel/PPPort/parts/inc/sv_xpvf Devel::PPPort include +ext/Devel/PPPort/parts/inc/threads Devel::PPPort include +ext/Devel/PPPort/parts/inc/uv Devel::PPPort include +ext/Devel/PPPort/parts/inc/version Devel::PPPort include +ext/Devel/PPPort/parts/ppptools.pl Devel::PPPort various utilities +ext/Devel/PPPort/parts/todo/5004000 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5004010 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5004020 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5004030 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5004040 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5004050 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5005000 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5005010 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5005020 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5005030 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5005040 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5006000 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5006001 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5006002 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5007000 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5007001 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5007002 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5007003 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5008000 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5008001 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5008002 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5008003 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5008004 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5008005 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5009000 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5009001 Devel::PPPort todo file +ext/Devel/PPPort/parts/todo/5009002 Devel::PPPort todo file +ext/Devel/PPPort/ppport_h.PL Devel::PPPort ppport.h writer +ext/Devel/PPPort/PPPort.pm Devel::PPPort extension +ext/Devel/PPPort/PPPort_pm.PL Devel::PPPort PPPort.pm writer +ext/Devel/PPPort/PPPort.xs Devel::PPPort extension +ext/Devel/PPPort/PPPort_xs.PL Devel::PPPort PPPort.xs writer ext/Devel/PPPort/README Devel::PPPort Readme -ext/Devel/PPPort/soak Test Harness to run Devel::PPPort other Perls +ext/Devel/PPPort/soak Devel::PPPort Test Harness to run under various Perls +ext/Devel/PPPort/t/call.t Devel::PPPort test file +ext/Devel/PPPort/t/cop.t Devel::PPPort test file +ext/Devel/PPPort/t/grok.t Devel::PPPort test file +ext/Devel/PPPort/t/limits.t Devel::PPPort test file +ext/Devel/PPPort/t/magic.t Devel::PPPort test file +ext/Devel/PPPort/t/misc.t Devel::PPPort test file +ext/Devel/PPPort/t/mPUSH.t Devel::PPPort test file +ext/Devel/PPPort/t/MY_CXT.t Devel::PPPort test file +ext/Devel/PPPort/t/newCONSTSUB.t Devel::PPPort test file +ext/Devel/PPPort/t/newRV.t Devel::PPPort test file ext/Devel/PPPort/TODO Devel::PPPort Todo -ext/Devel/PPPort/t/test.t See if Devel::PPPort works +ext/Devel/PPPort/t/ppphtest.t Devel::PPPort test file +ext/Devel/PPPort/t/SvPV.t Devel::PPPort test file +ext/Devel/PPPort/t/sv_xpvf.t Devel::PPPort test file +ext/Devel/PPPort/t/testutil.pl Devel::PPPort test utilities +ext/Devel/PPPort/t/threads.t Devel::PPPort test file +ext/Devel/PPPort/t/uv.t Devel::PPPort test file +ext/Devel/PPPort/typemap Devel::PPPort Typemap ext/Digest/MD5/Changes Digest::MD5 extension changes ext/Digest/MD5/hints/dec_osf.pl Hints for named architecture ext/Digest/MD5/hints/irix_6.pl Hints for named architecture @@ -763,6 +882,7 @@ ext/Time/HiRes/hints/svr4.pl Hints for Time::HiRes for named architecture ext/Time/HiRes/HiRes.pm Time::HiRes extension ext/Time/HiRes/HiRes.xs Time::HiRes extension ext/Time/HiRes/Makefile.PL Time::HiRes extension +ext/Time/HiRes/ppport.h portability header for Time::HiRes ext/Time/HiRes/t/HiRes.t Test for Time::HiRes ext/Time/HiRes/typemap Time::HiRes extension ext/Unicode/Normalize/Changes Unicode::Normalize @@ -787,6 +907,7 @@ ext/XS/APItest/APItest.xs XS::APItest extension ext/XS/APItest/Makefile.PL XS::APItest extension ext/XS/APItest/MANIFEST XS::APItest extension ext/XS/APItest/README XS::APItest extension +ext/XS/APItest/t/call.t XS::APItest extension ext/XS/APItest/t/hash.t XS::APItest extension ext/XS/APItest/t/printf.t XS::APItest extension ext/XS/APItest/t/push.t XS::APItest extension @@ -1303,6 +1424,7 @@ lib/I18N/LangTags/t/01_about_verbose.t See whether I18N::LangTags works lib/I18N/LangTags/t/05_main.t See whether I18N::LangTags works lib/I18N/LangTags/t/07_listy.t See whether I18N::LangTags works lib/I18N/LangTags/t/10_http.t See whether I18N::LangTags works +lib/I18N/LangTags/t/20_locales.t See whether I18N::LangTags works lib/I18N/LangTags/t/50_super.t See whether I18N::LangTags works lib/I18N/LangTags/t/55_supers_strict.t See whether I18N::LangTags works lib/I18N/LangTags/t/80_all_env.t See whether I18N::LangTags works @@ -2055,6 +2177,7 @@ pod/perl582delta.pod Perl changes in version 5.8.2 pod/perl583delta.pod Perl changes in version 5.8.3 pod/perl584delta.pod Perl changes in version 5.8.4 pod/perl585delta.pod Perl changes in version 5.8.5 +pod/perl586delta.pod Perl changes in version 5.8.6 pod/perl58delta.pod Perl changes in version 5.8.0 pod/perlapio.pod Perl internal IO abstraction interface pod/perlapi.pod Perl API listing (autogenerated) @@ -2155,6 +2278,7 @@ pod/splitpod Splits perlfunc into multiple pod pages Policy_sh.SH Hold site-wide preferences between Configure runs. Porting/apply Apply patches sent by mail Porting/check83.pl Check whether we are 8.3-friendly +Porting/checkAUTHORS.pl Check that the AUTHORS file is complete Porting/checkcase.pl Check whether we are case-insensitive-fs-friendly Porting/checkURL.pl Check whether we have working URLs Porting/checkVERSION.pl Check whether we have $VERSIONs @@ -2277,6 +2401,7 @@ t/comp/cpp.t See if C preprocessor works t/comp/decl.t See if declarations work t/comp/hints.t See if %^H works t/comp/multiline.t See if multiline strings work +t/comp/opsubs.t See if q() etc. are not parsed as functions t/comp/our.t Tests for our declaration t/comp/package.t See if packages work t/comp/parser.t See if the parser works in edge cases diff --git a/gnu/usr.bin/perl/Makefile.SH b/gnu/usr.bin/perl/Makefile.SH index d39d0c817b0..3aa03d2ba0f 100644 --- a/gnu/usr.bin/perl/Makefile.SH +++ b/gnu/usr.bin/perl/Makefile.SH @@ -349,7 +349,7 @@ c2 = perl.c perly.c pp.c pp_hot.c pp_ctl.c pp_sys.c regcomp.c regexec.c utf8.c c3 = gv.c sv.c taint.c toke.c util.c deb.c run.c universal.c xsutils.c pad.c c4 = globals.c perlio.c perlapi.c numeric.c locale.c pp_pack.c pp_sort.c -c = $(c1) $(c2) $(c3) $(c4) miniperlmain.c perlmain.c +c = $(c1) $(c2) $(c3) $(c4) miniperlmain.c perlmain.c opmini.c obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) pad$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT) reentr$(OBJ_EXT) obj2 = hv$(OBJ_EXT) av$(OBJ_EXT) run$(OBJ_EXT) pp_hot$(OBJ_EXT) sv$(OBJ_EXT) pp$(OBJ_EXT) scope$(OBJ_EXT) pp_ctl$(OBJ_EXT) pp_sys$(OBJ_EXT) @@ -402,11 +402,12 @@ $spitshell >>Makefile <<!GROK!THIS! # if we have a symlink forest to another disk (it complains about too many # levels of symbolic links, even if we have only two) -opmini\$(OBJ_EXT): op.c config.h - \$(RMS) opmini.c - \$(CPS) op.c opmini.c +opmini.c: op.c + \$(CPS) op.c opmini.tmp + sh mv-if-diff opmini.tmp opmini.c + +opmini\$(OBJ_EXT): opmini.c \$(CCCMD) \$(PLDLFLAGS) $DPERL_EXTERNAL_GLOB opmini.c - \$(RMS) opmini.c !GROK!THIS! $spitshell >>Makefile <<'!NO!SUBS!' @@ -784,7 +785,7 @@ extra.pods: miniperl$(EXE_EXT) -@rm -f pod/perlvms.pod -@test -f vms/perlvms.pod && cd pod && $(LNS) ../vms/perlvms.pod perlvms.pod && cd .. && echo "pod/perlvms.pod" >> extra.pods -@rm -f pod/perldelta.pod - -@test -f pod/perl585delta.pod && cd pod && $(LNS) perl585delta.pod perldelta.pod && cd .. && echo "pod/perldelta.pod" >> extra.pods + -@test -f pod/perl586delta.pod && cd pod && $(LNS) perl586delta.pod perldelta.pod && cd .. && echo "pod/perldelta.pod" >> extra.pods # See buildtoc extras.make: perl$(EXE_EXT) -@test -s extras.lst && PATH="`pwd`:${PATH}" PERL5LIB="`pwd`/lib" $(LDLIBPTH) ./perl -Ilib -MCPAN -e '@ARGV&&make(@ARGV)' `cat extras.lst` @@ -982,7 +983,7 @@ veryclean: _verycleaner _mopup _clobber # Do not 'make _mopup' directly. _mopup: - rm -f *$(OBJ_EXT) *$(LIB_EXT) all perlmain.c + rm -f *$(OBJ_EXT) *$(LIB_EXT) all perlmain.c opmini.c -rmdir .depending -@test -f extra.pods && rm -f `cat extra.pods` -@test -f vms/README_vms.pod && rm -f vms/README_vms.pod @@ -1081,6 +1082,7 @@ makedepend: makedepend.SH config.sh .PHONY: test check test_prep test_prep_nodll test_prep_pre _test_prep \ test_tty test-tty _test_tty test_notty test-notty _test_notty \ utest ucheck test.utf8 check.utf8 test.torture torturetest \ + test.utf16 check.utf16 utest.utf16 ucheck.utf16 \ test.third check.third utest.third ucheck.third test_notty.third \ test.deparse test_notty.deparse test_harness test_harness_notty \ test.bytecompile minitest coretest test.taintwarn @@ -1142,6 +1144,18 @@ test-notty: test_notty test.torture torturetest: test_prep PERL=./perl TEST_ARGS=-torture $(MAKE) _test +# Targets for UTF16 testing: + +minitest.utf16: minitest.prep + - cd t && (rm -f perl$(EXE_EXT); $(LNS) ../miniperl$(EXE_EXT) perl$(EXE_EXT)) \ + && $(LDLIBPTH) ./perl TEST -minitest -utf16 base/*.t comp/*.t cmd/*.t run/*.t io/*.t op/*.t uni/*.t </dev/tty + +test.utf16 check.utf16: test_prep + PERL=./perl $(MAKE) TEST_ARGS=-utf16 _test + +utest.utf16 ucheck.utf16: test_prep + PERL=./perl $(MAKE) TEST_ARGS="-utf8 -utf16" _test + # Targets for valgrind testing: test_prep.valgrind: test_prep perl.valgrind @@ -1188,15 +1202,17 @@ test_notty.deparse: test_prep test.taintwarn: test_prep PERL=./perl TEST_ARGS=-taintwarn $(MAKE) _test -# Can't depend on lib/Config.pm because that might be where miniperl -# is crashing. -minitest: miniperl$(EXE_EXT) lib/re.pm +minitest.prep: -@test -f lib/lib.pm && test -f lib/Config.pm || \ $(MAKE) lib/Config.pm lib/lib.pm $(unidatafiles) @echo " " @echo "You may see some irrelevant test failures if you have been unable" @echo "to build lib/Config.pm, lib/lib.pm or the Unicode data files." @echo " " + +# Can't depend on lib/Config.pm because that might be where miniperl +# is crashing. +minitest: miniperl$(EXE_EXT) lib/re.pm minitest.prep - cd t && (rm -f perl$(EXE_EXT); $(LNS) ../miniperl$(EXE_EXT) perl$(EXE_EXT)) \ && $(LDLIBPTH) ./perl TEST -minitest base/*.t comp/*.t cmd/*.t run/*.t io/*.t op/*.t uni/*.t </dev/tty diff --git a/gnu/usr.bin/perl/Makefile.bsd-wrapper b/gnu/usr.bin/perl/Makefile.bsd-wrapper index 20ab4b4c34e..8a79ff08b32 100644 --- a/gnu/usr.bin/perl/Makefile.bsd-wrapper +++ b/gnu/usr.bin/perl/Makefile.bsd-wrapper @@ -1,6 +1,6 @@ -# $OpenBSD: Makefile.bsd-wrapper,v 1.68 2004/08/14 00:12:22 millert Exp $ +# $OpenBSD: Makefile.bsd-wrapper,v 1.69 2005/01/15 21:30:17 millert Exp $ # -# Build wrapper for Perl 5.8.5 +# Build wrapper for Perl 5.8.6 # # For ``NOMAN'' and ``USE_GCC3'' @@ -70,6 +70,7 @@ MANSRCALL= perl583delta 1 pod/perl583delta.pod \ perl584delta 1 pod/perl584delta.pod \ perl585delta 1 pod/perl585delta.pod \ + perl586delta 1 pod/perl586delta.pod \ perlapi 1 pod/perlapi.pod \ perlapio 1 pod/perlapio.pod \ perlartistic 1 pod/perlartistic.pod \ @@ -190,6 +191,7 @@ MANSRCALL= B::Lint 3p ext/B/B/Lint.pm \ B::Showlex 3p ext/B/B/Showlex.pm \ B::Stackobj 3p ext/B/B/Stackobj.pm \ + B::Stash 3p ext/B/B/Stash.pm \ B::Terse 3p ext/B/B/Terse.pm \ B::Xref 3p ext/B/B/Xref.pm \ Benchmark 3p lib/Benchmark.pm \ diff --git a/gnu/usr.bin/perl/README.os2 b/gnu/usr.bin/perl/README.os2 index 7c45f11e1dd..7595eaf0b03 100644 --- a/gnu/usr.bin/perl/README.os2 +++ b/gnu/usr.bin/perl/README.os2 @@ -620,7 +620,7 @@ C<set PERLLIB_PREFIX> in F<Config.sys>, see L<"PERLLIB_PREFIX">. =item Additional Perl modules - unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.8.5/ + unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.8.6/ Same remark as above applies. Additionally, if this directory is not one of directories on @INC (and @INC is influenced by C<PERLLIB_PREFIX>), you diff --git a/gnu/usr.bin/perl/README.solaris b/gnu/usr.bin/perl/README.solaris index e1590d124d3..0b22f76f078 100644 --- a/gnu/usr.bin/perl/README.solaris +++ b/gnu/usr.bin/perl/README.solaris @@ -26,11 +26,15 @@ install it under a different prefix from /usr/perl5. Common prefixes to use are /usr/local and /opt/perl. You may wish to put your version of perl in the PATH of all users by -changing the link /usr/bin/perl. This is OK, as all perl scripts -shipped with Solaris use an explicit path. Solaris ships with a -range of Solaris-specific modules. If you choose to install your own -version of perl you will find the source of many of these modules is -available on CPAN under the Sun::Solaris:: namespace. +changing the link /usr/bin/perl. This is probably OK, as most perl +scripts shipped with Solaris use an explicit path. (There are a few +exceptions, such as /usr/bin/rpm2cpio and /etc/rcm/scripts/README, but +these are also sufficiently generic that the actual version of perl +probably doesn't matter too much.) + +Solaris ships with a range of Solaris-specific modules. If you choose +to install your own version of perl you will find the source of many of +these modules is available on CPAN under the Sun::Solaris:: namespace. Solaris may include two versions of perl, e.g. Solaris 9 includes both 5.005_03 and 5.6.1. This is to provide stability across Solaris @@ -587,7 +591,10 @@ software products, for example the Sun WebServer, which is part of the Solaris Server Intranet Extension, or the Sun Directory Services, part of Solaris for ISPs) or download the ANDIrand package from L<http://www.cosy.sbg.ac.at/~andi/>. If you use SUNWski, make a -symbolic link /dev/urandom pointing to /dev/random. +symbolic link /dev/urandom pointing to /dev/random. For more details, +see Document ID27606 entitled "Differing /dev/random support requirements +within Solaris[TM] Operating Environments", available at +http://sunsolve.sun.com . It may be possible to use the Entropy Gathering Daemon (written in Perl!), available from L<http://www.lothar.com/tech/crypto/>. @@ -684,4 +691,4 @@ Please report any errors, updates, or suggestions to F<perlbug@perl.org>. =head1 LAST MODIFIED -$Id: README.solaris,v 1.4 2000/11/11 20:29:58 doughera Exp $ +$Id: README.solaris,v 1.4 2003/12/03 03:02:19 millert Exp $ diff --git a/gnu/usr.bin/perl/README.vms b/gnu/usr.bin/perl/README.vms index cb2507f5ce1..1839bc7d18f 100644 --- a/gnu/usr.bin/perl/README.vms +++ b/gnu/usr.bin/perl/README.vms @@ -167,15 +167,15 @@ the ODS-2 compatability qualifiers such as: or: - vmstar -xvof perl-5^.8^.5.tar + vmstar -xvof perl-5^.8^.6.tar If you neglected to use the /ODS2 qualifier or the -o switch then you could rename the source directory: - set security/protection=(o:rwed) perl-5^.8^.5.dir - rename perl-5^.8^.5.dir perl-5_8_5.dir + set security/protection=(o:rwed) perl-5^.8^.6.dir + rename perl-5^.8^.6.dir perl-5_8_6.dir -Perl on VMS as of 5.8.5 does not completely handle extended file +Perl on VMS as of 5.8.6 does not completely handle extended file parse styles such as are encountered on ODS-5. While it can be built, installed, and run on ODS-5 filesystems; it may encounter trouble with characters that are otherwise illegal on ODS-2 diff --git a/gnu/usr.bin/perl/README.win32 b/gnu/usr.bin/perl/README.win32 index d3604beb68e..69fc56bf4fb 100644 --- a/gnu/usr.bin/perl/README.win32 +++ b/gnu/usr.bin/perl/README.win32 @@ -41,13 +41,18 @@ additional software to run (other than what came with your operating system). Currently, this port is capable of using one of the
following compilers on the Intel x86 architecture:
- Borland C++ version 5.02 or later
- Microsoft Visual C++ version 4.2 or later
- MinGW with gcc gcc version 2.95.2 or later
+ Borland C++ version 5.02 or later
+ Microsoft Visual C++ version 4.2 or later
+ MinGW with gcc gcc version 2.95.2 or later
The last of these is a high quality freeware compiler. Use version
3.2.x or later for the best results with this compiler.
+The Microsoft Visual C++ compiler is also now being given away free in
+the "Visual C++ Toolkit 2003", and also as part of the ".NET Framework
+SDK". This is the same compiler that ships with "Visual Studio .NET 2003
+Professional".
+
This port can also be built on the Intel IA64 using:
Microsoft Platform SDK Nov 2001 (64-bit compiler and tools)
@@ -122,7 +127,8 @@ See L</"Make"> above. The nmake that comes with Visual C++ will suffice for building.
You will need to run the VCVARS32.BAT file, usually found somewhere
-like C:\MSDEV4.2\BIN. This will set your build environment.
+like C:\MSDEV4.2\BIN or C:\Program Files\Microsoft Visual Studio\VC98\Bin.
+This will set your build environment.
You can also use dmake to build using Visual C++; provided, however,
you set OSRELEASE to "microsft" (or whatever the directory name
@@ -131,6 +137,84 @@ and edit win32/config.vc to change "make=nmake" into "make=dmake". The latter step is only essential if you want to use dmake as your default
make for building extensions using MakeMaker.
+=item Microsoft Visual C++ Toolkit 2003
+
+This free toolkit contains the same compiler and linker that ship with
+Visual Studio .NET 2003 Professional, but doesn't contain everything
+necessary to build Perl.
+
+You will also need to download the "Platform SDK" (the "Core SDK" and "MDAC
+SDK" components are required) for header files, libraries and rc.exe, and
+".NET Framework SDK" for more libraries and nmake.exe. Note that the latter
+(which also includes the free compiler and linker) requires the ".NET
+Framework Redistributable" to be installed first. This can be downloaded and
+installed separately, but is included in the "Visual C++ Toolkit 2003" anyway.
+
+These packages can all be downloaded by searching in the Download Center at
+http://www.microsoft.com/downloads/search.aspx?displaylang=en
+
+Note that the "Platform SDK February 2003" download requires Internet Explorer
+5.0 to function. Alternatively, the very latest version at the time of writing
+(called "Windows XP Service Pack 2 Platform SDK RC2") is now available as an
+ISO-9660 CD image file and does not require IE5 to be downloaded but will only
+work on Windows XP.
+
+According to the download pages the Toolkit and the .NET Framework SDK are only
+supported on Windows 2000/XP/2003, so trying to use these tools on Windows
+95/98/ME and even Windows NT probably won't work.
+
+Install the Toolkit first, then the Platform SDK, then the .NET Framework SDK.
+Setup your environment as follows (assuming default installation locations
+were chosen):
+
+ SET PATH=%SystemRoot%\system32;%SystemRoot%;C:\Program Files\Microsoft Visual C++ Toolkit 2003\bin;C:\Program Files\Microsoft SDK\Bin;C:\Program Files\Microsoft.NET\SDK\v1.1\Bin
+ SET INCLUDE=C:\Program Files\Microsoft Visual C++ Toolkit 2003\include;C:\Program Files\Microsoft SDK\include;C:\Program Files\Microsoft Visual Studio .NET 2003\Vc7\include
+ SET LIB=C:\Program Files\Microsoft Visual C++ Toolkit 2003\lib;C:\Program Files\Microsoft SDK\lib;C:\Program Files\Microsoft Visual Studio .NET 2003\Vc7\lib
+
+Several required files will still be missing:
+
+=over 4
+
+=item *
+
+cvtres.exe is required by link.exe when using a .res file. It is actually
+installed by the .NET Framework SDK, but into a location such as the
+following:
+
+ C:\WINDOWS\Microsoft.NET\Framework\v1.1.4322
+
+Copy it from there to C:\Program Files\Microsoft SDK\Bin
+
+=item *
+
+lib.exe is normally used to build libraries, but link.exe with the /lib
+option also works, so create a batch file called lib.bat in
+C:\Program Files\Microsoft Visual C++ Toolkit 2003\bin containing:
+
+ @echo off
+ link /lib %*
+
+This will work as long as "lib.exe" is invoked simply as "lib" (which it is
+during the Perl build process).
+
+=item *
+
+setargv.obj is required to build perlglob.exe (and perl.exe if the USE_SETARGV
+option is enabled). The Platform SDK supplies this object file in source form
+in C:\Program Files\Microsoft SDK\src\crt. Copy setargv.c, cruntime.h and
+internal.h from there to some temporary location and build setargv.obj using
+
+ cl.exe /c /I. /D_CRTBLD setargv.c
+
+Then copy setargv.obj to C:\Program Files\Microsoft SDK\lib
+
+=back
+
+Perl should now build using the win32/Makefile. You will need to edit that
+file to comment-out CCTYPE = MSVC60 (since that enables delay-loading of the
+Winsock DLL which the free toolkit does not support) and to set CCHOME,
+CCINCDIR and CCLIBDIR as per the environment setup above.
+
=item Microsoft Platform SDK 64-bit Compiler
The nmake that comes with the Platform SDK will suffice for building
@@ -139,8 +223,8 @@ shells available after you install the Platform SDK from the Start Menu. =item MinGW release 3 with gcc
-The latest release of MinGW at the time of writing is 3.1.0, which comes
-with gcc-3.2.3, and can be downloaded here:
+The latest release of MinGW at the time of writing is 3.1.0, which contains
+gcc-3.2.3. It can be downloaded here:
http://www.mingw.org/
@@ -151,7 +235,7 @@ You also need dmake. See L</"Make"> above on how to get it. =item MinGW release 1 with gcc
-The MinGW-1.1 bundle comes with gcc-2.95.3.
+The MinGW-1.1 bundle contains gcc-2.95.3.
Make sure you install the binaries that work with MSVCRT.DLL as indicated
in the README for the GCC bundle. You may need to set up a few environment
@@ -197,8 +281,7 @@ Make sure you are in the "win32" subdirectory under the perl toplevel. This directory contains a "Makefile" that will work with
versions of nmake that come with Visual C++ or the Platform SDK, and
a dmake "makefile.mk" that will work for all supported compilers. The
-defaults in the dmake makefile are setup to build using Microsoft Visual
-C++ 6.0 or newer.
+defaults in the dmake makefile are setup to build using MinGW/gcc.
=item *
@@ -224,7 +307,7 @@ If you have either the source or a library that contains des_fcrypt(), enable the appropriate option in the makefile. A ready-to-use version
of fcrypt.c, based on the version originally written by Eric Young at
ftp://ftp.funet.fi/pub/crypt/mirrors/dsi/libdes/, is bundled with the
-distribution. Set CRYPT_SRC to fcrypt.c to use this version.
+distribution and CRYPT_SRC is set to use it.
Alternatively, if you have built a library that contains des_fcrypt(),
you can set CRYPT_LIB to point to the library name.
Perl will also build without des_fcrypt(), but the crypt() builtin will
@@ -301,19 +384,20 @@ Please report any other failures as described under L<BUGS AND CAVEATS>. Type "dmake install" (or "nmake install"). This will put the newly
built perl and the libraries under whatever C<INST_TOP> points to in the
Makefile. It will also install the pod documentation under
-C<$INST_TOP\$VERSION\lib\pod> and HTML versions of the same under
-C<$INST_TOP\$VERSION\lib\pod\html>. To use the Perl you just installed,
-you will need to add two components to your PATH environment variable,
-C<$INST_TOP\$VERSION\bin> and C<$INST_TOP\$VERSION\bin\$ARCHNAME>.
-For example:
+C<$INST_TOP\$INST_VER\lib\pod> and HTML versions of the same under
+C<$INST_TOP\$INST_VER\lib\pod\html>.
+
+To use the Perl you just installed you will need to add a new entry to
+your PATH environment variable: C<$INST_TOP\bin>, e.g.
- set PATH c:\perl\5.6.0\bin;c:\perl\5.6.0\bin\MSWin32-x86;%PATH%
+ set PATH=c:\perl\bin;%PATH%
-If you opt to comment out INST_VER and INST_ARCH in the makefiles, the
-installation structure is much simpler. In that case, it will be
-sufficient to add a single entry to the path, for instance:
+If you opted to uncomment C<INST_VER> and C<INST_ARCH> in the makefile
+then the installation structure is a little more complicated and you will
+need to add two new PATH components instead: C<$INST_TOP\$INST_VER\bin> and
+C<$INST_TOP\$INST_VER\bin\$ARCHNAME>, e.g.
- set PATH c:\perl\bin;%PATH%
+ set PATH=c:\perl\5.6.0\bin;c:\perl\5.6.0\bin\MSWin32-x86;%PATH%
=head2 Usage Hints for Perl on Win32
@@ -394,7 +478,7 @@ enclosing the whole argument within double quotes. The backslash and the pair of double quotes surrounding the argument will be stripped by
the C runtime.
-The file redirection characters "<", ">", and "|" can be quoted by
+The file redirection characters "E<lt>", "E<gt>", and "|" can be quoted by
double quotes (although there are suggestions that this may not always
be true). Single quotes are not treated as quotes by the shell or
the C runtime, they don't get stripped by the shell (just to make
@@ -574,11 +658,11 @@ cannot be built using the generic steps shown in the previous section. To ensure smooth transitioning of existing code that uses the
ActiveState port, there is a bundle of Win32 extensions that contains
-all of the ActiveState extensions and most other Win32 extensions from
+all of the ActiveState extensions and several other Win32 extensions from
CPAN in source form, along with many added bugfixes, and with MakeMaker
support. This bundle is available at:
- http://www.cpan.org/authors/id/GSAR/libwin32-0.18.zip
+ http://www.cpan.org/modules/by-module/Win32/libwin32-0.191.zip
See the README in that distribution for building and installation
instructions. Look for later versions that may be available at the
@@ -603,6 +687,8 @@ binaries transparently. This means that you could use a 32-bit build of Perl on a 64-bit system. Given this, why would one want to build
a 64-bit build of Perl? Here are some reasons why you would bother:
+=over
+
=item *
A 64-bit native application will run much more efficiently on
@@ -623,6 +709,8 @@ Embedding Perl inside a 64-bit application. =back
+=back
+
=head2 Running Perl Scripts
Perl scripts on UNIX use the "#!" (a.k.a "shebang") line to
@@ -691,7 +779,9 @@ Here's a diversion: copy "runperl.bat" to "runperl", and type "runperl". Explain the observed behavior, or lack thereof. :)
Hint: .gnidnats llits er'uoy fi ,"lrepnur" eteled :tniH
-=item Miscellaneous Things
+=back
+
+=head2 Miscellaneous Things
A full set of HTML documentation is installed, so you should be
able to use it if you have a web browser installed on your
@@ -716,8 +806,6 @@ If you find bugs in perl, you can run C<perlbug> to create a bug report (you may have to send it manually if C<perlbug> cannot
find a mailer on your system).
-=back
-
=head1 BUGS AND CAVEATS
Norton AntiVirus interferes with the build process, particularly if
@@ -738,7 +826,7 @@ Some of the built-in functions do not act exactly as documented in L<perlfunc>, and a few are not implemented at all. To avoid
surprises, particularly if you have had prior exposure to Perl
in other operating environments or if you intend to write code
-that will be portable to other environments. See L<perlport>
+that will be portable to other environments, see L<perlport>
for a reasonably definitive list of these differences.
Not all extensions available from CPAN may build or work properly
@@ -746,6 +834,12 @@ in the Win32 environment. See L</"Building Extensions">. Most C<socket()> related calls are supported, but they may not
behave as on Unix platforms. See L<perlport> for the full list.
+Perl requires Winsock2 to be installed on the system. If you're
+running Win95, you can download Winsock upgrade from here:
+
+http://www.microsoft.com/windows95/downloads/contents/WUAdminTools/S_WUNetworkingTools/W95Sockets2/Default.asp
+
+Later OS versions already include Winsock2 support.
Signal handling may not behave as on Unix platforms (where it
doesn't exactly "behave", either :). For instance, calling C<die()>
@@ -756,8 +850,8 @@ variable in the handler. Using signals under this port should currently be considered unsupported.
Please send detailed descriptions of any problems and solutions that
-you may find to <F<perlbug@perl.com>>, along with the output produced
-by C<perl -V>.
+you may find to E<lt>F<perlbug@perl.org>E<gt>, along with the output
+produced by C<perl -V>.
=head1 ACKNOWLEDGEMENTS
@@ -801,6 +895,6 @@ Win9x support was added in 5.6 (Benjamin Stuhl). Support for 64-bit Windows added in 5.8 (ActiveState Corp).
-Last updated: 20 April 2002
+Last updated: 30 July 2004
=cut
diff --git a/gnu/usr.bin/perl/av.c b/gnu/usr.bin/perl/av.c index 22cba0fea7a..e05be1eb795 100644 --- a/gnu/usr.bin/perl/av.c +++ b/gnu/usr.bin/perl/av.c @@ -864,6 +864,8 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags) SvREFCNT_dec(sv); sv = Nullsv; } + else if (AvREAL(av)) + sv = sv_2mortal(sv); return sv; } diff --git a/gnu/usr.bin/perl/configpm b/gnu/usr.bin/perl/configpm index 84814275a87..95ef8e14143 100644 --- a/gnu/usr.bin/perl/configpm +++ b/gnu/usr.bin/perl/configpm @@ -218,6 +218,34 @@ while (<CONFIG_SH>) { } close CONFIG_SH; +# Calculation for the keys for byteorder +# This is somewhat grim, but I need to run fetch_string here. +our $Config_SH = join "\n", @v_fast, @v_others; + +my $t = fetch_string ({}, 'ivtype'); +my $s = fetch_string ({}, 'ivsize'); + +# byteorder does exist on its own but we overlay a virtual +# dynamically recomputed value. + +# However, ivtype and ivsize will not vary for sane fat binaries + +my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I'; + +my $byteorder_code; +if ($s == 4 || $s == 8) { + my $list = join ',', reverse(2..$s); + my $format = 'a'x$s; + $byteorder_code = <<"EOT"; +my \$i = 0; +foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 } +\$i |= ord(1); +my \$byteorder = join('', unpack('$format', pack('$f', \$i))); +EOT +} else { + $byteorder_code = "my \$byteorder = '?'x$s;\n"; +} + print CONFIG @non_v, "\n"; # copy config summary format from the myconfig.SH script @@ -231,7 +259,7 @@ close(MYCONFIG); # before expanding it, because may have been made readonly if a perl # interpreter has been cloned. -print CONFIG "\n!END!\n", <<'EOT'; +print CONFIG "\n!END!\n", $byteorder_code, <<'EOT'; my $summary_expanded; sub myconfig { @@ -241,12 +269,19 @@ sub myconfig { $summary_expanded; } -our $Config_SH : unique = <<'!END!'; +local *_ = \my $a; +$_ = <<'!END!'; EOT print CONFIG join("", @v_fast, sort @v_others); -print CONFIG "!END!\n", $fetch_string; +print CONFIG <<'EOT'; +!END! +s/(byteorder=)(['"]).*?\2/$1$2$byteorder$2/m; +our $Config_SH : unique = $_; +EOT + +print CONFIG $fetch_string; print CONFIG <<'ENDOFEND'; @@ -341,11 +376,15 @@ sub config_re { } sub config_vars { + # implements -V:cfgvar option (see perlrun -V:) foreach (@_) { + # find optional leading, trailing colons; and query-spec my ($notag,$qry,$lncont) = m/^(:)?(.*?)(:)?$/; # flags fore and aft, - my $prfx = $notag ? '': "$qry="; # prefix for print - my $lnend = $lncont ? ' ' : ";\n"; # ending for print + # map colon-flags to print decorations + my $prfx = $notag ? '': "$qry="; # tag-prefix for print + my $lnend = $lncont ? ' ' : ";\n"; # line ending for print + # all config-vars are by definition \w only, any \W means regex if ($qry =~ /\W/) { my @matches = config_re($qry); print map "$_$lnend", @matches ? @matches : "$qry: not found" if !$notag; @@ -392,45 +431,14 @@ sub TIEHASH { ENDOFSET } - -# Calculation for the keys for byteorder -# This is somewhat grim, but I need to run fetch_string here. -our $Config_SH = join "\n", @v_fast, @v_others; - -my $t = fetch_string ({}, 'ivtype'); -my $s = fetch_string ({}, 'ivsize'); - -# byteorder does exist on its own but we overlay a virtual -# dynamically recomputed value. - -# However, ivtype and ivsize will not vary for sane fat binaries - -my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I'; - -my $byteorder_code; -if ($s == 4 || $s == 8) { - my $list = join ',', reverse(2..$s); - my $format = 'a'x$s; - $byteorder_code = <<"EOT"; -my \$i = 0; -foreach my \$c ($list) { \$i |= ord(\$c); \$i <<= 8 } -\$i |= ord(1); -my \$value = join('', unpack('$format', pack('$f', \$i))); -EOT -} else { - $byteorder_code = "\$value = '?'x$s;\n"; -} - my $fast_config = join '', map { " $_,\n" } - sort values (%v_fast), 'byteorder => $value' ; + sort values (%v_fast), 'byteorder => $byteorder' ; -print CONFIG sprintf <<'ENDOFTIE', $byteorder_code, $fast_config; +print CONFIG sprintf <<'ENDOFTIE', $fast_config; # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD sub DESTROY { } -%s - tie %%Config, 'Config', { %s }; diff --git a/gnu/usr.bin/perl/deb.c b/gnu/usr.bin/perl/deb.c index 3bd8111c90d..6d4ae63b0f9 100644 --- a/gnu/usr.bin/perl/deb.c +++ b/gnu/usr.bin/perl/deb.c @@ -13,6 +13,11 @@ * have seen more than thou knowest, Gray Fool." --Denethor */ +/* + * This file contains various utilities for producing debugging output + * (mainly related to displaying the stack) + */ + #include "EXTERN.h" #define PERL_IN_DEB_C #include "perl.h" diff --git a/gnu/usr.bin/perl/doio.c b/gnu/usr.bin/perl/doio.c index 97a6603869d..59081d88c09 100644 --- a/gnu/usr.bin/perl/doio.c +++ b/gnu/usr.bin/perl/doio.c @@ -15,6 +15,11 @@ * chattering, into calmer and more level reaches." */ +/* This file contains functions that do the actual I/O on behalf of ops. + * For example, pp_print() calls the do_print() function in this file for + * each argument needing printing. + */ + #include "EXTERN.h" #define PERL_IN_DOIO_C #include "perl.h" diff --git a/gnu/usr.bin/perl/doop.c b/gnu/usr.bin/perl/doop.c index 3c4b3c8634a..a76a305364f 100644 --- a/gnu/usr.bin/perl/doop.c +++ b/gnu/usr.bin/perl/doop.c @@ -12,6 +12,11 @@ * "'So that was the job I felt I had to do when I started,' thought Sam." */ +/* This file contains some common functions needed to carry out certain + * ops. For example both pp_schomp() and pp_chomp() - scalar and array + * chomp operations - call the function do_chomp() found in this file. + */ + #include "EXTERN.h" #define PERL_IN_DOOP_C #include "perl.h" diff --git a/gnu/usr.bin/perl/dump.c b/gnu/usr.bin/perl/dump.c index 645e34f0ae6..79aa2c19c6a 100644 --- a/gnu/usr.bin/perl/dump.c +++ b/gnu/usr.bin/perl/dump.c @@ -13,6 +13,13 @@ * it has not been hard for me to read your mind and memory.'" */ +/* This file contains utility routines to dump the contents of SV and OP + * structures, as used by command-line options like -Dt and -Dx, and + * by Devel::Peek. + * + * It also holds the debugging version of the runops function. + */ + #include "EXTERN.h" #define PERL_IN_DUMP_C #include "perl.h" diff --git a/gnu/usr.bin/perl/embed.h b/gnu/usr.bin/perl/embed.h index 94b51d25b18..a9edeea615a 100644 --- a/gnu/usr.bin/perl/embed.h +++ b/gnu/usr.bin/perl/embed.h @@ -2185,6 +2185,11 @@ #ifdef PERL_CORE #define magic_scalarpack Perl_magic_scalarpack #endif +#if defined(DEBUGGING) +#ifdef PERL_CORE +#define get_debug_opts_flags Perl_get_debug_opts_flags +#endif +#endif #define ck_anoncode Perl_ck_anoncode #define ck_bitop Perl_ck_bitop #define ck_concat Perl_ck_concat @@ -4702,6 +4707,11 @@ #ifdef PERL_CORE #define magic_scalarpack(a,b) Perl_magic_scalarpack(aTHX_ a,b) #endif +#if defined(DEBUGGING) +#ifdef PERL_CORE +#define get_debug_opts_flags(a,b) Perl_get_debug_opts_flags(aTHX_ a,b) +#endif +#endif #define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a) #define ck_bitop(a) Perl_ck_bitop(aTHX_ a) #define ck_concat(a) Perl_ck_concat(aTHX_ a) diff --git a/gnu/usr.bin/perl/ext/B/B/Concise.pm b/gnu/usr.bin/perl/ext/B/B/Concise.pm index 88a31b63873..668b378276e 100644 --- a/gnu/usr.bin/perl/ext/B/B/Concise.pm +++ b/gnu/usr.bin/perl/ext/B/B/Concise.pm @@ -14,13 +14,16 @@ use warnings; # uses #3 and #4, since warnings uses Carp use Exporter (); # use #5 -# Maint doesn't have patch 22353 (op_seq changes) - -our $VERSION = "0.61"; +our $VERSION = "0.64"; our @ISA = qw(Exporter); -our @EXPORT_OK = qw(set_style set_style_standard add_callback - concise_subref concise_cv concise_main - add_style walk_output); +our @EXPORT_OK = qw( set_style set_style_standard add_callback + concise_subref concise_cv concise_main + add_style walk_output compile reset_sequence ); +our %EXPORT_TAGS = + ( io => [qw( walk_output compile reset_sequence )], + style => [qw( add_style set_style_standard )], + cb => [qw( add_callback )], + mech => [qw( concise_subref concise_cv concise_main )], ); # use #6 use B qw(class ppname main_start main_root main_cv cstring svref_2object @@ -35,8 +38,8 @@ my %style = "#class pp_#name"], "concise" => ["#hyphseq2 (*( (x( ;)x))*)<#classsym> " - . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x)\n", - " (*( )*) goto #seq\n", + . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x)\n" + , " (*( )*) goto #seq\n", "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"], "linenoise" => ["(x(;(*( )*))x)#noise#arg(?([#targarg])?)(x( ;\n)x)", @@ -44,8 +47,9 @@ my %style = "(?(#seq)?)#noise#arg(?([#targarg])?)"], "debug" => ["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t" - . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n\top_seq\t\t" - . "#seqnum\n\top_flags\t#flagval\n\top_private\t#privval\n" + . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n" . + ($] > 5.009 ? '' : "\top_seq\t\t#seqnum\n") + . "\top_flags\t#flagval\n\top_private\t#privval\n" . "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)" . "(?(\top_sv\t\t#svaddr\n)?)", " GOTO #addr\n", @@ -69,8 +73,9 @@ my $base = 36; # how <sequence#> is displayed my $big_endian = 1; # more <sequence#> display my $tree_style = 0; # tree-order details my $banner = 1; # print banner before optree is traversed +my $do_main = 0; # force printing of main routine -# another factor: +# another factor: can affect all styles! our @callbacks; # allow external management set_style_standard("concise"); @@ -104,29 +109,51 @@ sub add_callback { } # output handle, used with all Concise-output printing -our $walkHandle = \*STDOUT; # public for your convenience +our $walkHandle; # public for your convenience +BEGIN { $walkHandle = \*STDOUT } sub walk_output { # updates $walkHandle my $handle = shift; + return $walkHandle unless $handle; # allow use as accessor + if (ref $handle eq 'SCALAR') { + require Config; + die "no perlio in this build, can't call walk_output (\\\$scalar)\n" + unless $Config::Config{useperlio}; # in 5.8+, open(FILEHANDLE,MODE,REFERENCE) writes to string - open my $tmp, '>', $handle; # but cant re-set an existing filehandle + open my $tmp, '>', $handle; # but cant re-set existing STDOUT $walkHandle = $tmp; # so use my $tmp as intermediate var - return; + return $walkHandle; } - $walkHandle = $handle; - my $iotype = ref $walkHandle; + my $iotype = ref $handle; die "expecting argument/object that can print\n" - unless $iotype eq 'GLOB' or $iotype and $walkHandle->can('print'); + unless $iotype eq 'GLOB' or $iotype and $handle->can('print'); + $walkHandle = $handle; } sub concise_subref { my($order, $coderef) = @_; my $codeobj = svref_2object($coderef); - die "err: not a coderef: $coderef\n" unless ref $codeobj eq 'B::CV';#CODE'; + + return concise_stashref(@_) + unless ref $codeobj eq 'B::CV'; concise_cv_obj($order, $codeobj); } +sub concise_stashref { + my($order, $h) = @_; + foreach my $k (sort keys %$h) { + local *s = $h->{$k}; + my $coderef = *s{CODE} or next; + reset_sequence(); + print "FUNC: ", *s, "\n"; + my $codeobj = svref_2object($coderef); + next unless ref $codeobj eq 'B::CV'; + eval { concise_cv_obj($order, $codeobj) } + or warn "err $@ on $codeobj"; + } +} + # This should have been called concise_subref, but it was exported # under this name in versions before 0.56 sub concise_cv { concise_subref(@_); } @@ -187,18 +214,22 @@ my @tree_decorations = [" ", map("$start_sym$_$end_sym", "q", "w", "t", "x", "m"), "", 0], ); -sub compile { + +sub compileOpts { + # set rendering state from options and args my @options = grep(/^-/, @_); my @args = grep(!/^-/, @_); - my $do_main = 0; for my $o (@options) { + # mode/order if ($o eq "-basic") { $order = "basic"; } elsif ($o eq "-exec") { $order = "exec"; } elsif ($o eq "-tree") { $order = "tree"; - } elsif ($o eq "-compact") { + } + # tree-specific + elsif ($o eq "-compact") { $tree_style |= 1; } elsif ($o eq "-loose") { $tree_style &= ~1; @@ -206,17 +237,26 @@ sub compile { $tree_style |= 2; } elsif ($o eq "-ascii") { $tree_style &= ~2; - } elsif ($o eq "-main") { - $do_main = 1; - } elsif ($o =~ /^-base(\d+)$/) { + } + # sequence numbering + elsif ($o =~ /^-base(\d+)$/) { $base = $1; } elsif ($o eq "-bigendian") { $big_endian = 1; } elsif ($o eq "-littleendian") { $big_endian = 0; - } elsif ($o eq "-banner") { + } + elsif ($o eq "-nobanner") { $banner = 0; + } elsif ($o eq "-banner") { + $banner = 1; + } + elsif ($o eq "-main") { + $do_main = 1; + } elsif ($o eq "-nomain") { + $do_main = 0; } + # line-style options elsif (exists $style{substr($o, 1)}) { $stylename = substr($o, 1); set_style_standard($stylename); @@ -224,48 +264,58 @@ sub compile { warn "Option $o unrecognized"; } } + return (@args); +} + +sub compile { + my (@args) = compileOpts(@_); return sub { - if (@args) { - for my $objname (@args) { - if ($objname eq "BEGIN") { - concise_specials("BEGIN", $order, - B::begin_av->isa("B::AV") ? - B::begin_av->ARRAY : ()); - } elsif ($objname eq "INIT") { - concise_specials("INIT", $order, - B::init_av->isa("B::AV") ? - B::init_av->ARRAY : ()); - } elsif ($objname eq "CHECK") { - concise_specials("CHECK", $order, - B::check_av->isa("B::AV") ? - B::check_av->ARRAY : ()); - } elsif ($objname eq "END") { - concise_specials("END", $order, - B::end_av->isa("B::AV") ? - B::end_av->ARRAY : ()); + my @newargs = compileOpts(@_); # accept new rendering options + warn "disregarding non-options: @newargs\n" if @newargs; + + for my $objname (@args) { + next unless $objname; # skip null args to avoid noisy responses + + if ($objname eq "BEGIN") { + concise_specials("BEGIN", $order, + B::begin_av->isa("B::AV") ? + B::begin_av->ARRAY : ()); + } elsif ($objname eq "INIT") { + concise_specials("INIT", $order, + B::init_av->isa("B::AV") ? + B::init_av->ARRAY : ()); + } elsif ($objname eq "CHECK") { + concise_specials("CHECK", $order, + B::check_av->isa("B::AV") ? + B::check_av->ARRAY : ()); + } elsif ($objname eq "END") { + concise_specials("END", $order, + B::end_av->isa("B::AV") ? + B::end_av->ARRAY : ()); + } + else { + # convert function names to subrefs + my $objref; + if (ref $objname) { + print $walkHandle "B::Concise::compile($objname)\n" + if $banner; + $objref = $objname; } else { - # convert function names to subrefs - my $objref; - if (ref $objname) { - print $walkHandle "B::Concise::compile($objname)\n" - if $banner; - $objref = $objname; - } else { - $objname = "main::" . $objname unless $objname =~ /::/; - print $walkHandle "$objname:\n"; - no strict 'refs'; - die "err: unknown function ($objname)\n" - unless *{$objname}{CODE}; - $objref = \&$objname; - } - concise_subref($order, $objref); + $objname = "main::" . $objname unless $objname =~ /::/; + print $walkHandle "$objname:\n"; + no strict 'refs'; + die "err: unknown function ($objname)\n" + unless *{$objname}{CODE}; + $objref = \&$objname; } + concise_subref($order, $objref); } } if (!@args or $do_main) { print $walkHandle "main program:\n" if $do_main; concise_main($order); } + return @args; # something } } @@ -327,6 +377,7 @@ sub reset_sequence { # reset the sequence %sequence_num = (); $seq_max = 1; + $lastnext = 0; } sub seq { @@ -383,9 +434,15 @@ sub walk_exec { push @$targ, $ar; push @todo, [$op->pmreplstart, $ar]; } elsif ($name =~ /^enter(loop|iter)$/) { - $labels{$op->nextop->seq} = "NEXT"; - $labels{$op->lastop->seq} = "LAST"; - $labels{$op->redoop->seq} = "REDO"; + if ($] > 5.009) { + $labels{${$op->nextop}} = "NEXT"; + $labels{${$op->lastop}} = "LAST"; + $labels{${$op->redoop}} = "REDO"; + } else { + $labels{$op->nextop->seq} = "NEXT"; + $labels{$op->lastop->seq} = "LAST"; + $labels{$op->redoop->seq} = "REDO"; + } } } } @@ -429,19 +486,34 @@ sub sequence { } sub fmt_line { # generate text-line for op. - my($hr, $text, $level) = @_; + my($hr, $op, $text, $level) = @_; + + $_->($hr, $op, \$text, \$level, $stylename) for @callbacks; + return '' if $hr->{SKIP}; # suppress line if a callback said so + return '' if $hr->{goto} and $hr->{goto} eq '-'; # no goto nowhere + # spec: (?(text1#varText2)?) $text =~ s/\(\?\(([^\#]*?)\#(\w+)([^\#]*?)\)\?\)/ $hr->{$2} ? $1.$hr->{$2}.$3 : ""/eg; + # spec: (x(exec_text;basic_text)x) $text =~ s/\(x\((.*?);(.*?)\)x\)/$order eq "exec" ? $1 : $2/egs; + + # spec: (*(text)*) $text =~ s/\(\*\(([^;]*?)\)\*\)/$1 x $level/egs; + + # spec: (*(text1;text2)*) $text =~ s/\(\*\((.*?);(.*?)\)\*\)/$1 x ($level - 1) . $2 x ($level>0)/egs; + + # convert #Var to tag=>val form: Var\t#var + $text =~ s/\#([A-Z][a-z]+)(\d+)?/\t\u$1\t\L#$1$2/gs; + + # spec: #varN $text =~ s/\#([a-zA-Z]+)(\d+)/sprintf("%-$2s", $hr->{$1})/eg; - $text =~ s/\#([a-zA-Z]+)/$hr->{$1}/eg; # populate data into template - $text =~ s/[ \t]*~+[ \t]*/ /g; + $text =~ s/\#([a-zA-Z]+)/$hr->{$1}/eg; # populate #var's + $text =~ s/[ \t]*~+[ \t]*/ /g; # squeeze tildes chomp $text; return "$text\n" if $text ne ""; return $text; # suppress empty lines @@ -463,8 +535,7 @@ $priv{"repeat"}{64} = "DOLIST"; $priv{"leaveloop"}{64} = "CONT"; @{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV") for (qw(rv2gv rv2sv padsv aelem helem)); -$priv{"entersub"}{16} = "DBG"; -$priv{"entersub"}{32} = "TARG"; +@{$priv{"entersub"}}{16,32,64} = ("DBG","TARG","NOMOD"); @{$priv{$_}}{4,8,128} = ("INARGS","AMPER","NO()") for ("entersub", "rv2cv"); $priv{"gv"}{32} = "EARLYCV"; $priv{"aelem"}{16} = $priv{"helem"}{16} = "LVDEFER"; @@ -482,7 +553,8 @@ $priv{$_}{16} = "TARGMY" "link", "symlink", "mkdir", "rmdir", "wait", "waitpid", "system", "exec", "kill", "getppid", "getpgrp", "setpgrp", "getpriority", "setpriority", "time", "sleep"); -@{$priv{"const"}}{8,16,32,64,128} = ("STRICT","ENTERED", '$[', "BARE", "WARN"); +$priv{$_}{4} = "REVERSED" for ("enteriter", "iter"); +@{$priv{"const"}}{4,8,16,32,64,128} = ("SHORT","STRICT","ENTERED",'$[',"BARE","WARN"); $priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM"; $priv{"list"}{64} = "GUESSED"; $priv{"delete"}{64} = "SLICE"; @@ -490,7 +562,7 @@ $priv{"exists"}{64} = "SUB"; $priv{$_}{64} = "LOCALE" for ("sort", "prtf", "sprintf", "slt", "sle", "seq", "sne", "sgt", "sge", "scmp", "lc", "uc", "lcfirst", "ucfirst"); -@{$priv{"sort"}}{1,2,4,8} = ("NUM", "INT", "REV", "INPLACE"); +@{$priv{"sort"}}{1,2,4,8,16} = ("NUM", "INT", "REV", "INPLACE","DESC"); $priv{"threadsv"}{64} = "SVREFd"; @{$priv{$_}}{16,32,64,128} = ("INBIN","INCR","OUTBIN","OUTCR") for ("open", "backtick"); @@ -555,7 +627,10 @@ sub concise_sv { } elsif (class($sv) eq "HV") { $hr->{svval} .= 'HASH'; } - return $hr->{svclass} . " " . $hr->{svval}; + + $hr->{svval} = 'undef' unless defined $hr->{svval}; + my $out = $hr->{svclass}; + return $out .= " $hr->{svval}" ; } } @@ -669,7 +744,14 @@ sub concise_op { } $h{seq} = $h{hyphseq} = seq($op); $h{seq} = "" if $h{seq} eq "-"; - $h{seqnum} = $op->seq; + if ($] > 5.009) { + $h{opt} = $op->opt; + $h{static} = $op->static; + $h{label} = $labels{$$op}; + } else { + $h{seqnum} = $op->seq; + $h{label} = $labels{$op->seq}; + } $h{next} = $op->next; $h{next} = (class($h{next}) eq "NULL") ? "(end)" : seq($h{next}); $h{nextaddr} = sprintf("%#x", $ {$op->next}); @@ -683,21 +765,21 @@ sub concise_op { $h{privval} = $op->private; $h{private} = private_flags($h{name}, $op->private); $h{addr} = sprintf("%#x", $$op); - $h{label} = $labels{$op->seq}; $h{typenum} = $op->type; $h{noise} = $linenoise[$op->type]; - $_->(\%h, $op, \$format, \$level, $stylename) for @callbacks; - return fmt_line(\%h, $format, $level); + return fmt_line(\%h, $op, $format, $level); } sub B::OP::concise { my($op, $level) = @_; if ($order eq "exec" and $lastnext and $$lastnext != $$op) { # insert a 'goto' line - my $h = {"seq" => seq($lastnext), "class" => class($lastnext), - "addr" => sprintf("%#x", $$lastnext)}; - print $walkHandle fmt_line($h, $gotofmt, $level+1); + my $synth = {"seq" => seq($lastnext), "class" => class($lastnext), + "addr" => sprintf("%#x", $$lastnext), + "goto" => seq($lastnext), # simplify goto '-' removal + }; + print $walkHandle fmt_line($synth, $op, $gotofmt, $level+1); } $lastnext = $op->next; print $walkHandle concise_op($op, $level, $format); @@ -722,10 +804,12 @@ sub b_terse { # insert a 'goto' my $h = {"seq" => seq($lastnext), "class" => class($lastnext), "addr" => sprintf("%#x", $$lastnext)}; - print fmt_line($h, $style{"terse"}[1], $level+1); + print # $walkHandle + fmt_line($h, $op, $style{"terse"}[1], $level+1); } $lastnext = $op->next; - print concise_op($op, $level, $style{"terse"}[0]); + print # $walkHandle + concise_op($op, $level, $style{"terse"}[0]); } sub tree { @@ -764,29 +848,26 @@ sub tree { # *** Warning: fragile kludge ahead *** # Because the B::* modules run in the same interpreter as the code -# they're compiling, their presence tends to distort the view we have -# of the code we're looking at. In particular, perl gives sequence -# numbers to both OPs in general and COPs in particular. If the -# program we're looking at were run on its own, these numbers would -# start at 1. Because all of B::Concise and all the modules it uses -# are compiled first, though, by the time we get to the user's program -# the sequence numbers are alreay at pretty high numbers, which would -# be distracting if you're trying to tell OPs apart. Therefore we'd -# like to subtract an offset from all the sequence numbers we display, -# to restore the simpler view of the world. The trick is to know what -# that offset will be, when we're still compiling B::Concise! If we +# they're compiling, their presence tends to distort the view we have of +# the code we're looking at. In particular, perl gives sequence numbers +# to COPs. If the program we're looking at were run on its own, this +# would start at 1. Because all of B::Concise and all the modules it +# uses are compiled first, though, by the time we get to the user's +# program the sequence number is already pretty high, which could be +# distracting if you're trying to tell OPs apart. Therefore we'd like to +# subtract an offset from all the sequence numbers we display, to +# restore the simpler view of the world. The trick is to know what that +# offset will be, when we're still compiling B::Concise! If we # hardcoded a value, it would have to change every time B::Concise or -# other modules we use do. To help a little, what we do here is -# compile a little code at the end of the module, and compute the base -# sequence number for the user's program as being a small offset -# later, so all we have to worry about are changes in the offset. -# (Note that we now only play this game with COP sequence numbers. OP -# sequence numbers aren't used to refer to OPs from a distance, and -# they don't have much significance, so we just generate our own -# sequence numbers which are easier to control. This way we also don't -# stand in the way of a possible future removal of OP sequence -# numbers). - +# other modules we use do. To help a little, what we do here is compile +# a little code at the end of the module, and compute the base sequence +# number for the user's program as being a small offset later, so all we +# have to worry about are changes in the offset. + +# [For 5.8.x and earlier perl is generating sequence numbers for all ops, +# and using them to reference labels] + + # When you say "perl -MO=Concise -e '$a'", the output should look like: # 4 <@> leave[t1] vKP/REFC ->(end) @@ -1010,19 +1091,42 @@ obviously mutually exclusive with bigendian. =head2 Other options +These are pairwise exclusive. + =over 4 =item B<-main> Include the main program in the output, even if subroutines were also -specified. This is the only option that is not sticky (see below) +specified. This rendering is normally suppressed when a subroutine +name or reference is given. + +=item B<-nomain> + +This restores the default behavior after you've changed it with '-main' +(it's not normally needed). If no subroutine name/ref is given, main is +rendered, regardless of this flag. + +=item B<-nobanner> + +Renderings usually include a banner line identifying the function name +or stringified subref. This suppresses the printing of the banner. + +TBC: Remove the stringified coderef; while it provides a 'cookie' for +each function rendered, the cookies used should be 1,2,3.. not a +random hex-address. It also complicates string comparison of two +different trees. =item B<-banner> -B::Concise::compile normally prints a banner line identifying the -function name, or in case of a subref, a generic message including -(unfortunately) the stringified coderef. This option suppresses the -printing of the banner. +restores default banner behavior. + +=item B<-banneris> => subref + +TBC: a hookpoint (and an option to set it) for a user-supplied +function to produce a banner appropriate for users needs. It's not +ideal, because the rendering-state variables, which are a natural +candidate for use in concise.t, are unavailable to the user. =back @@ -1033,6 +1137,46 @@ the options are 'sticky'. This means that the options you provide in the first call will be remembered for the 2nd call, unless you re-specify or change them. +=head1 ABBREVIATIONS + +The concise style uses symbols to convey maximum info with minimal +clutter (like hex addresses). With just a little practice, you can +start to see the flowers, not just the branches, in the trees. + +=head2 OP class abbreviations + +These symbols appear before the op-name, and indicate the +B:: namespace that represents the ops in your Perl code. + + 0 OP (aka BASEOP) An OP with no children + 1 UNOP An OP with one child + 2 BINOP An OP with two children + | LOGOP A control branch OP + @ LISTOP An OP that could have lots of children + / PMOP An OP with a regular expression + $ SVOP An OP with an SV + " PVOP An OP with a string + { LOOP An OP that holds pointers for a loop + ; COP An OP that marks the start of a statement + # PADOP An OP with a GV on the pad + +=head2 OP flags abbreviations + +These symbols represent various flags which alter behavior of the +opcode, sometimes in opcode-specific ways. + + v OPf_WANT_VOID Want nothing (void context) + s OPf_WANT_SCALAR Want single value (scalar context) + l OPf_WANT_LIST Want list of any length (list context) + K OPf_KIDS There is a firstborn child. + P OPf_PARENS This operator was parenthesized. + (Or block needs explicit scope entry.) + R OPf_REF Certified reference. + (Return container, not containee). + M OPf_MOD Will modify (lvalue). + S OPf_STACKED Some arg is arriving on the stack. + * OPf_SPECIAL Do something weird for this op (see op.h) + =head1 FORMATTING SPECIFICATIONS For each line-style ('concise', 'terse', 'linenoise', etc.) there are @@ -1044,10 +1188,18 @@ mode when branches are encountered. They're not real opcodes, and are inserted to look like a closing curly brace. The tree-format is tree specific. -When a line is rendered, the correct format string is scanned for the -following items, and data is substituted in, or other manipulations, -like basic indenting. Any text that doesn't match a special pattern -(the items below) is copied verbatim. (Yes, it's a set of s///g steps.) +When a line is rendered, the correct format-spec is copied and scanned +for the following items; data is substituted in, and other +manipulations like basic indenting are done, for each opcode rendered. + +There are 3 kinds of items that may be populated; special patterns, +#vars, and literal text, which is copied verbatim. (Yes, it's a set +of s///g steps.) + +=head2 Special Patterns + +These items are the primitives used to perform indenting, and to +select text from amongst alternatives. =over 4 @@ -1070,33 +1222,64 @@ If the value of I<var> is true (not empty or zero), generates the value of I<var> surrounded by I<text1> and I<Text2>, otherwise nothing. +=item B<~> + +Any number of tildes and surrounding whitespace will be collapsed to +a single space. + +=back + +=head2 # Variables + +These #vars represent opcode properties that you may want as part of +your rendering. The '#' is intended as a private sigil; a #var's +value is interpolated into the style-line, much like "read $this". + +These vars take 3 forms: + +=over 4 + =item B<#>I<var> -Generates the value of the variable I<var>. +A property named 'var' is assumed to exist for the opcodes, and is +interpolated into the rendering. =item B<#>I<var>I<N> -Generates the value of I<var>, left jutified to fill I<N> spaces. +Generates the value of I<var>, left justified to fill I<N> spaces. +Note that this means while you can have properties 'foo' and 'foo2', +you cannot render 'foo2', but you could with 'foo2a'. You would be +wise not to rely on this behavior going forward ;-) -=item B<~> +=item B<#>I<Var> -Any number of tildes and surrounding whitespace will be collapsed to -a single space. +This ucfirst form of #var generates a tag-value form of itself for +display; it converts '#Var' into a 'Var => #var' style, which is then +handled as described above. (Imp-note: #Vars cannot be used for +conditional-fills, because the => #var transform is done after the check +for #Var's value). =back -The following variables are recognized: +The following variables are 'defined' by B::Concise; when they are +used in a style, their respective values are plugged into the +rendering of each opcode. + +Only some of these are used by the standard styles, the others are +provided for you to delve into optree mechanics, should you wish to +add a new style (see L</add_style> below) that uses them. You can +also add new ones using L<add_callback>. =over 4 =item B<#addr> -The address of the OP, in hexidecimal. +The address of the OP, in hexadecimal. =item B<#arg> The OP-specific information of the OP (such as the SV for an SVOP, the -non-local exit pointers for a LOOP, etc.) enclosed in paretheses. +non-local exit pointers for a LOOP, etc.) enclosed in parentheses. =item B<#class> @@ -1173,17 +1356,31 @@ The numeric value of the OP's private flags. =item B<#seq> -The sequence number of the OP. Note that this is now a sequence number -generated by B::Concise, rather than the real op_seq value (for which -see B<#seqnum>). +The sequence number of the OP. Note that this is a sequence number +generated by B::Concise. =item B<#seqnum> +5.8.x and earlier only. 5.9 and later do not provide this. + The real sequence number of the OP, as a regular number and not adjusted to be relative to the start of the real program. (This will generally be a fairly large number because all of B<B::Concise> is compiled before your program is). +=item B<#opt> + +Whether or not the op has been optimised by the peephole optimiser. + +Only available in 5.9 and later. + +=item B<#static> + +Whether or not the op is statically defined. This flag is used by the +B::C compiler backend and indicates that the op should not be freed. + +Only available in 5.9 and later. + =item B<#sibaddr> The address of the OP's next youngest sibling, in hexidecimal. @@ -1221,59 +1418,31 @@ The numeric value of the OP's type, in decimal. =back -=head1 ABBREVIATIONS - -=head2 OP flags abbreviations - - v OPf_WANT_VOID Want nothing (void context) - s OPf_WANT_SCALAR Want single value (scalar context) - l OPf_WANT_LIST Want list of any length (list context) - K OPf_KIDS There is a firstborn child. - P OPf_PARENS This operator was parenthesized. - (Or block needs explicit scope entry.) - R OPf_REF Certified reference. - (Return container, not containee). - M OPf_MOD Will modify (lvalue). - S OPf_STACKED Some arg is arriving on the stack. - * OPf_SPECIAL Do something weird for this op (see op.h) - -=head2 OP class abbreviations - - 0 OP (aka BASEOP) An OP with no children - 1 UNOP An OP with one child - 2 BINOP An OP with two children - | LOGOP A control branch OP - @ LISTOP An OP that could have lots of children - / PMOP An OP with a regular expression - $ SVOP An OP with an SV - " PVOP An OP with a string - { LOOP An OP that holds pointers for a loop - ; COP An OP that marks the start of a statement - # PADOP An OP with a GV on the pad - =head1 Using B::Concise outside of the O framework -You can use B<B::Concise>, and call compile() directly, and +The common (and original) usage of B::Concise was for command-line +renderings of simple code, as given in EXAMPLE. But you can also use +B<B::Concise> from your code, and call compile() directly, and repeatedly. By doing so, you can avoid the compile-time only -operation of 'perl -MO=Concise ..'. For example, you can use the -debugger to step through B::Concise::compile() itself. +operation of O.pm, and even use the debugger to step through +B::Concise::compile() itself. -When doing so, you can alter Concise output by providing new output -styles, and optionally by adding callback routines which populate new -variables that may be rendered as part of those styles. For all -following sections, please review L</FORMATTING SPECIFICATIONS>. +Once you're doing this, you may alter Concise output by adding new +rendering styles, and by optionally adding callback routines which +populate new variables, if such were referenced from those (just +added) styles. =head2 Example: Altering Concise Renderings use B::Concise qw(set_style add_callback); - set_style($your_format, $your_gotofmt, $your_treefmt); + add_style($yourStyleName => $defaultfmt, $gotofmt, $treefmt); add_callback ( sub { my ($h, $op, $format, $level, $stylename) = @_; $h->{variable} = some_func($op); - } - ); - B::Concise::compile(@options)->(); + }); + $walker = B::Concise::compile(@options,@subnames,@subrefs); + $walker->(); =head2 set_style() @@ -1324,27 +1493,37 @@ changed or even used. B<compile> accepts options as described above in L</OPTIONS>, and arguments, which are either coderefs, or subroutine names. -compile() constructs and returns a coderef, which when invoked, scans -the optree, and prints the results to STDOUT. Once you have the -coderef, you may change the output style; thereafter the coderef renders -in the new style. +It constructs and returns a $treewalker coderef, which when invoked, +traverses, or walks, and renders the optrees of the given arguments to +STDOUT. You can reuse this, and can change the rendering style used +each time; thereafter the coderef renders in the new style. B<walk_output> lets you change the print destination from STDOUT to -another open filehandle, or into a string passed as a ref. +another open filehandle, or (unless you've built with -Uuseperlio) +into a string passed as a ref. + my $walker = B::Concise::compile('-terse','aFuncName', \&aSubRef); # 1 walk_output(\my $buf); - my $walker = B::Concise::compile('-concise','funcName', \&aSubRef); - print "Concise Banner for Functions: $buf\n"; - $walker->(); - print "Concise Rendering(s)?: $buf\n"; - -For each subroutine visited by Concise, the $buf will contain a -banner naming the function or coderef about to be traversed. -Once $walker is invoked, it prints the actual renderings for each. - -To switch back to one of the standard styles like C<concise> or -C<terse>, call C<set_style_standard>, or pass the style name into -B::Concise::compile() (as done above). + $walker->(); # 1 renders -terse + set_style_standard('concise'); # 2 + $walker->(); # 2 renders -concise + $walker->(@new); # 3 renders whatever + print "3 different renderings: terse, concise, and @new: $buf\n"; + +When $walker is called, it traverses the subroutines supplied when it +was created, and renders them using the current style. You can change +the style afterwards in several different ways: + + 1. call C<compile>, altering style or mode/order + 2. call C<set_style_standard> + 3. call $walker, passing @new options + +Passing new options to the $walker is the easiest way to change +amongst any pre-defined styles (the ones you add are automatically +recognized as options), and is the only way to alter rendering order +without calling compile again. Note however that rendering state is +still shared amongst multiple $walker objects, so they must still be +used in a coordinated manner. =head2 B::Concise::reset_sequence() diff --git a/gnu/usr.bin/perl/ext/Cwd/Cwd.xs b/gnu/usr.bin/perl/ext/Cwd/Cwd.xs index 2b02f802b71..0b340abb80f 100644 --- a/gnu/usr.bin/perl/ext/Cwd/Cwd.xs +++ b/gnu/usr.bin/perl/ext/Cwd/Cwd.xs @@ -420,10 +420,10 @@ PPCODE: else croak("Usage: getdcwd(DRIVE)"); - /* Pass a NULL pointer as the second argument to have space allocated. */ - if (dir = _getdcwd(drive, NULL, MAXPATHLEN)) { + New(0,dir,MAXPATHLEN,char); + if (_getdcwd(drive, dir, MAXPATHLEN)) { sv_setpvn(TARG, dir, strlen(dir)); - free(dir); + Safefree(dir); SvPOK_only(TARG); } else diff --git a/gnu/usr.bin/perl/ext/DB_File/DB_File.pm b/gnu/usr.bin/perl/ext/DB_File/DB_File.pm index 3f53d468cdf..5ddac46c963 100644 --- a/gnu/usr.bin/perl/ext/DB_File/DB_File.pm +++ b/gnu/usr.bin/perl/ext/DB_File/DB_File.pm @@ -1,8 +1,8 @@ # DB_File.pm -- Perl 5 interface to Berkeley DB # # written by Paul Marquess (pmqs@cpan.org) -# last modified 20th June 2004 -# version 1.809 +# last modified 7th August 2004 +# version 1.810 # # Copyright (c) 1995-2004 Paul Marquess. All rights reserved. # This program is free software; you can redistribute it and/or @@ -165,7 +165,7 @@ our ($db_version, $use_XSLoader, $splice_end_array); use Carp; -$VERSION = "1.809" ; +$VERSION = "1.810" ; { local $SIG{__WARN__} = sub {$splice_end_array = "@_";}; diff --git a/gnu/usr.bin/perl/ext/DB_File/DB_File.xs b/gnu/usr.bin/perl/ext/DB_File/DB_File.xs index eb83670338d..8f6cec1cc39 100644 --- a/gnu/usr.bin/perl/ext/DB_File/DB_File.xs +++ b/gnu/usr.bin/perl/ext/DB_File/DB_File.xs @@ -3,8 +3,8 @@ DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess <pmqs@cpan.org> - last modified 20th June 2004 - version 1.809 + last modified 7th August 2004 + version 1.810 All comments/suggestions/problems are welcome @@ -109,6 +109,7 @@ 1.807 - no change 1.808 - leak fixed in ParseOpenInfo 1.809 - no change + 1.810 - no change */ @@ -397,8 +398,9 @@ typedef DBT DBTKEY ; #define OutputValue(arg, name) \ { if (RETVAL == 0) { \ + SvGETMAGIC(arg) ; \ my_sv_setpvn(arg, name.data, name.size) ; \ - TAINT; \ + TAINT; \ SvTAINTED_on(arg); \ SvUTF8_off(arg); \ DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \ @@ -408,12 +410,13 @@ typedef DBT DBTKEY ; #define OutputKey(arg, name) \ { if (RETVAL == 0) \ { \ + SvGETMAGIC(arg) ; \ if (db->type != DB_RECNO) { \ my_sv_setpvn(arg, name.data, name.size); \ } \ else \ sv_setiv(arg, (I32)*(I32*)name.data - 1); \ - TAINT; \ + TAINT; \ SvTAINTED_on(arg); \ SvUTF8_off(arg); \ DBM_ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \ diff --git a/gnu/usr.bin/perl/ext/DB_File/Makefile.PL b/gnu/usr.bin/perl/ext/DB_File/Makefile.PL index 17562b87631..2c970b733f3 100644 --- a/gnu/usr.bin/perl/ext/DB_File/Makefile.PL +++ b/gnu/usr.bin/perl/ext/DB_File/Makefile.PL @@ -14,7 +14,7 @@ $LIB = "-llibdb" if $^O eq 'MSWin32' ; WriteMakefile( NAME => 'DB_File', - LIBS => ["-L/usr/local/lib $LIB"], + #LIBS => ["-L/usr/local/lib $LIB"], MAN3PODS => {}, # Pods will be built by installman. #INC => '-I/usr/local/include', VERSION_FROM => 'DB_File.pm', diff --git a/gnu/usr.bin/perl/ext/Devel/PPPort/PPPort.pm b/gnu/usr.bin/perl/ext/Devel/PPPort/PPPort.pm index 45a34b667b1..073f34e2e19 100644 --- a/gnu/usr.bin/perl/ext/Devel/PPPort/PPPort.pm +++ b/gnu/usr.bin/perl/ext/Devel/PPPort/PPPort.pm @@ -1,4 +1,27 @@ -package Devel::PPPort; +################################################################################ +# +# !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!! +# +################################################################################ +# +# Perl/Pollution/Portability +# +################################################################################ +# +# $Revision: 30 $ +# $Author: mhx $ +# $Date: 2004/08/17 20:01:49 +0200 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ =head1 NAME @@ -6,382 +29,3414 @@ Devel::PPPort - Perl/Pollution/Portability =head1 SYNOPSIS - Devel::PPPort::WriteFile() ; # defaults to ./ppport.h - Devel::PPPort::WriteFile('someheader.h') ; + Devel::PPPort::WriteFile(); # defaults to ./ppport.h + Devel::PPPort::WriteFile('someheader.h'); =head1 DESCRIPTION -Perl has changed over time, gaining new features, new functions, +Perl's API has changed over time, gaining new features, new functions, increasing its flexibility, and reducing the impact on the C namespace -environment (reduced pollution). The header file, typicaly C<ppport.h>, -written by this module attempts to bring some of the newer Perl +environment (reduced pollution). The header file written by this module, +typically F<ppport.h>, attempts to bring some of the newer Perl API features to older versions of Perl, so that you can worry less about keeping track of old releases, but users can still reap the benefit. + +C<Devel::PPPort> contains a single function, called C<WriteFile>. Its +only purpose is to write the F<ppport.h> C header file. This file +contains a series of macros and, if explicitly requested, functions that +allow XS modules to be built using older versions of Perl. Currently, +Perl versions from 5.003 to 5.9.2 are supported. + +This module is used by C<h2xs> to write the file F<ppport.h>. + +=head2 Why use ppport.h? -Why you should use C<ppport.h> in modern code: so that your code will work +You should use F<ppport.h> in modern code so that your code will work with the widest range of Perl interpreters possible, without significant additional work. -Why you should attempt older code to fully use C<ppport.h>: because -the reduced pollution of newer Perl versions is an important thing, so +You should attempt older code to fully use F<ppport.h>, because the +reduced pollution of newer Perl versions is an important thing. It's so important that the old polluting ways of original Perl modules will not be supported very far into the future, and your module will almost certainly -break! By adapting to it now, you'll gained compatibility and a sense of +break! By adapting to it now, you'll gain compatibility and a sense of having done the electronic ecology some good. -How to use ppport.h: Don't direct the user to download C<Devel::PPPort>, -and don't make C<ppport.h> optional. Rather, just take the most recent -copy of C<ppport.h> that you can find (probably in C<Devel::PPPort> -on CPAN), copy it into your project, adjust your project to use it, -and distribute the header along with your module. +=head2 How to use ppport.h + +Don't direct the users of your module to download C<Devel::PPPort>. +They are most probably no XS writers. Also, don't make F<ppport.h> +optional. Rather, just take the most recent copy of F<ppport.h> that +you can find (e.g. by generating it with the latest C<Devel::PPPort> +release from CPAN), copy it into your project, adjust your project to +use it, and distribute the header along with your module. + +=head2 Running ppport.h + +But F<ppport.h> is more than just a C header. It's also a Perl script +that can check your source code. It will suggest hints and portability +notes, and can even make suggestions on how to change your code. You +can run it like any other Perl program: + + perl ppport.h + +It also has embedded documentation, so you can use -C<Devel::PPPort> contains a single function, called C<WriteFile>. It's -purpose is to write a 'C' header file that is used when writing XS -modules. The file contains a series of macros that allow XS modules to -be built using older versions of Perl. + perldoc ppport.h -This module is used by h2xs to write the file F<ppport.h>. +to find out more about how to use it. + +=head1 FUNCTIONS =head2 WriteFile -C<WriteFile> takes a zero or one parameters. When called with one -parameter it expects to be passed a filename. When called with no -parameters, it defults to the filename C<./pport.h>. +C<WriteFile> takes one optional argument. When called with one +argument, it expects to be passed a filename. When called with +no arguments, it defaults to the filename F<ppport.h>. + +The function returns a true value if the file was written successfully. +Otherwise it returns a false value. + +=head1 COMPATIBILITY -The function returns TRUE if the file was written successfully. Otherwise -it returns FALSE. +F<ppport.h> supports Perl versions from 5.003 to 5.9.2 +in threaded and non-threaded configurations. -=head1 ppport.h +=head2 Provided Perl compatibility API -The file written by this module, typically C<ppport.h>, provides access -to the following Perl API if not already available (and in some cases [*] -even if available, access to a fixed interface): +The header file written by this module, typically F<ppport.h>, provides +access to the following elements of the Perl API that is not available +in older Perl releases: + _aMY_CXT + _pMY_CXT aMY_CXT aMY_CXT_ - _aMY_CXT aTHX aTHX_ AvFILLp - boolSV(b) + boolSV call_argv call_method call_pv call_sv + CopFILE + CopFILE_set + CopFILEAV + CopFILEGV + CopFILEGV_set + CopFILESV + CopSTASH + CopSTASH_eq + CopSTASH_set + CopSTASHPV + CopSTASHPV_set + CopyD dAX DEFSV dITEMS - dMY_CXT + dMY_CXT dMY_CXT_SV dNOOP dTHR dTHX dTHXa dTHXoa + dUNDERBAR + END_EXTERN_C ERRSV + eval_pv + eval_sv + EXTERN_C get_av get_cv get_hv get_sv - grok_hex - grok_oct grok_bin + grok_hex grok_number + GROK_NUMERIC_RADIX grok_numeric_radix - gv_stashpvn(str,len,flags) - INT2PTR(type,int) + grok_oct + gv_stashpvn + IN_LOCALE + IN_LOCALE_COMPILETIME + IN_LOCALE_RUNTIME + IN_PERL_COMPILETIME + INT2PTR + IS_NUMBER_GREATER_THAN_UV_MAX + IS_NUMBER_IN_UV + IS_NUMBER_INFINITY + IS_NUMBER_NAN + IS_NUMBER_NEG + IS_NUMBER_NOT_INT IVdf + IVSIZE + IVTYPE + memEQ + memNE + MoveD + mPUSHi + mPUSHn + mPUSHp + mPUSHu + mXPUSHi + mXPUSHn + mXPUSHp + mXPUSHu MY_CXT + MY_CXT_CLONE MY_CXT_INIT - newCONSTSUB(stash,name,sv) - newRV_inc(sv) - newRV_noinc(sv) - newSVpvn(data,len) + newCONSTSUB + newRV_inc + newRV_noinc + newSVpvn + newSVuv NOOP - NV + NUM2PTR NVef NVff NVgf + NVTYPE + PERL_BCDVERSION + PERL_GCC_BRACE_GROUPS_FORBIDDEN + PERL_INT_MAX + PERL_INT_MIN + PERL_LONG_MAX + PERL_LONG_MIN + PERL_MAGIC_arylen + PERL_MAGIC_backref + PERL_MAGIC_bm + PERL_MAGIC_collxfrm + PERL_MAGIC_dbfile + PERL_MAGIC_dbline + PERL_MAGIC_defelem + PERL_MAGIC_env + PERL_MAGIC_envelem + PERL_MAGIC_ext + PERL_MAGIC_fm + PERL_MAGIC_glob + PERL_MAGIC_isa + PERL_MAGIC_isaelem + PERL_MAGIC_mutex + PERL_MAGIC_nkeys + PERL_MAGIC_overload + PERL_MAGIC_overload_elem + PERL_MAGIC_overload_table + PERL_MAGIC_pos + PERL_MAGIC_qr + PERL_MAGIC_regdata + PERL_MAGIC_regdatum + PERL_MAGIC_regex_global + PERL_MAGIC_shared + PERL_MAGIC_shared_scalar + PERL_MAGIC_sig + PERL_MAGIC_sigelem + PERL_MAGIC_substr + PERL_MAGIC_sv + PERL_MAGIC_taint + PERL_MAGIC_tied + PERL_MAGIC_tiedelem + PERL_MAGIC_tiedscalar + PERL_MAGIC_utf8 + PERL_MAGIC_uvar + PERL_MAGIC_uvar_elem + PERL_MAGIC_vec + PERL_MAGIC_vstring + PERL_QUAD_MAX + PERL_QUAD_MIN PERL_REVISION + PERL_SCAN_ALLOW_UNDERSCORES + PERL_SCAN_DISALLOW_PREFIX + PERL_SCAN_GREATER_THAN_UV_MAX + PERL_SCAN_SILENT_ILLDIGIT + PERL_SHORT_MAX + PERL_SHORT_MIN PERL_SUBVERSION + PERL_UCHAR_MAX + PERL_UCHAR_MIN + PERL_UINT_MAX + PERL_UINT_MIN + PERL_ULONG_MAX + PERL_ULONG_MIN PERL_UNUSED_DECL + PERL_UQUAD_MAX + PERL_UQUAD_MIN + PERL_USHORT_MAX + PERL_USHORT_MIN PERL_VERSION PL_compiling PL_copline PL_curcop PL_curstash + PL_DBsingle + PL_DBsub + PL_debstash PL_defgv + PL_diehook PL_dirty + PL_dowarn + PL_errgv + PL_hexdigit PL_hints PL_na + PL_no_modify + PL_perl_destruct_level PL_perldb + PL_ppaddr + PL_rsfp PL_rsfp_filters - PL_rsfpv + PL_stack_base + PL_stack_sp PL_stdingv PL_Sv + PL_sv_arenaroot PL_sv_no PL_sv_undef PL_sv_yes + PL_tainted + PL_tainting pMY_CXT pMY_CXT_ - _pMY_CXT + Poison pTHX pTHX_ - PTR2IV(ptr) - PTR2NV(ptr) - PTR2ul(ptr) - PTR2UV(ptr) + PTR2IV + PTR2NV + PTR2ul + PTR2UV + PTRV + PUSHmortal + PUSHu SAVE_DEFSV + START_EXTERN_C START_MY_CXT - SvPVbyte(sv,lp) [*] + STMT_END + STMT_START + sv_2pv_nolen + sv_2pvbyte + sv_2uv + sv_catpv_mg + sv_catpvf_mg + sv_catpvf_mg_nocontext + sv_catpvn_mg + sv_catpvn_nomg + sv_catsv_mg + sv_catsv_nomg + sv_pvn + sv_pvn_force + sv_pvn_nomg + sv_setiv_mg + sv_setnv_mg + sv_setpv_mg + sv_setpvf_mg + sv_setpvf_mg_nocontext + sv_setpvn_mg + sv_setsv_mg + sv_setsv_nomg + sv_setuv + sv_setuv_mg + sv_usepvn_mg + sv_uv + sv_vcatpvf + sv_vcatpvf_mg + sv_vsetpvf + sv_vsetpvf_mg + SvGETMAGIC + SvIV_nomg + SvPV_force_nomg + SvPV_nolen + SvPV_nomg + SvPVbyte + SvUV + SvUV_nomg + SvUVX + SvUVx + SvUVXx + UNDERBAR UVof UVSIZE + UVTYPE UVuf - UVxf UVXf - -=head1 AUTHOR + UVxf + vnewSVpvf + XPUSHmortal + XPUSHu + XSRETURN_UV + XST_mUV + ZeroD + +=head2 Perl API not supported by ppport.h + +There is still a big part of the API not supported by F<ppport.h>. +Either because it doesn't make sense to back-port that part of the API, +or simply because it hasn't been implemented yet. Patches welcome! + +Here's a list of the currently unsupported API, and also the version of +Perl below which it is unsupported: + +=over 4 + +=item perl 5.9.2 + + SvPVbyte_force + find_rundefsvoffset + vnormal + +=item perl 5.9.1 + + hv_assert + hv_clear_placeholders + hv_scalar + scan_version + sv_2iv_flags + sv_2uv_flags + +=item perl 5.9.0 + + new_version + save_set_svflags + upg_version + vcmp + vnumify + vstringify + +=item perl 5.8.3 + + SvIsCOW + SvIsCOW_shared_hash + +=item perl 5.8.1 + + SvVOK + doing_taint + is_utf8_string_loc + packlist + save_bool + savestack_grow_cnt + scan_vstring + sv_cat_decode + sv_compile_2op + sv_setpviv + sv_setpviv_mg + unpackstring + +=item perl 5.8.0 + + hv_iternext_flags + hv_store_flags + is_utf8_idcont + nothreadhook + +=item perl 5.7.3 + + PerlIO_clearerr + PerlIO_close + PerlIO_eof + PerlIO_error + PerlIO_fileno + PerlIO_fill + PerlIO_flush + PerlIO_get_base + PerlIO_get_bufsiz + PerlIO_get_cnt + PerlIO_get_ptr + PerlIO_read + PerlIO_seek + PerlIO_set_cnt + PerlIO_set_ptrcnt + PerlIO_setlinebuf + PerlIO_stderr + PerlIO_stdin + PerlIO_stdout + PerlIO_tell + PerlIO_unread + PerlIO_write + SvLOCK + SvSHARE + SvUNLOCK + atfork_lock + atfork_unlock + custom_op_desc + custom_op_name + deb + debstack + debstackptrs + gv_fetchmeth_autoload + ibcmp_utf8 + my_fork + my_socketpair + pack_cat + perl_destruct + pv_uni_display + regclass_swash + save_shared_pvref + savesharedpv + sortsv + sv_copypv + sv_magicext + sv_nolocking + sv_nosharing + sv_nounlocking + sv_recode_to_utf8 + sv_uni_display + to_uni_fold + to_uni_lower + to_uni_title + to_uni_upper + to_utf8_case + to_utf8_fold + to_utf8_lower + to_utf8_title + to_utf8_upper + unpack_str + uvchr_to_utf8_flags + uvuni_to_utf8_flags + vdeb + +=item perl 5.7.2 + + calloc + getcwd_sv + init_tm + malloc + mfree + mini_mktime + my_atof2 + my_strftime + op_null + realloc + sv_2pv_flags + sv_catpvn_flags + sv_catsv_flags + sv_pvn_force_flags + sv_setsv_flags + sv_utf8_upgrade_flags + swash_fetch + +=item perl 5.7.1 + + POPpbytex + SvUOK + bytes_from_utf8 + csighandler + despatch_signals + do_openn + gv_handler + is_lvalue_sub + my_popen_list + newSVpvn_share + save_mortalizesv + save_padsv + scan_num + sv_force_normal_flags + sv_setref_uv + sv_unref_flags + sv_utf8_upgrade + utf8_length + utf8_to_uvchr + utf8_to_uvuni + utf8n_to_uvchr + utf8n_to_uvuni + uvchr_to_utf8 + uvuni_to_utf8 + +=item perl 5.6.1 + + apply_attrs_string + bytes_to_utf8 + gv_efullname4 + gv_fullname4 + is_utf8_string + save_generic_pvref + utf16_to_utf8 + utf16_to_utf8_reversed + utf8_to_bytes + +=item perl 5.6.0 + + SvIOK_UV + SvIOK_notUV + SvIOK_only_UV + SvPOK_only_UTF8 + SvPVbyte_nolen + SvPVbytex + SvPVbytex_force + SvPVutf8 + SvPVutf8_force + SvPVutf8_nolen + SvPVutf8x + SvPVutf8x_force + SvUTF8 + SvUTF8_off + SvUTF8_on + av_delete + av_exists + call_atexit + cast_i32 + cast_iv + cast_ulong + cast_uv + do_gv_dump + do_gvgv_dump + do_hv_dump + do_magic_dump + do_op_dump + do_open9 + do_pmop_dump + do_sv_dump + dump_all + dump_eval + dump_form + dump_indent + dump_packsubs + dump_sub + dump_vindent + get_context + get_ppaddr + gv_dump + init_i18nl10n + init_i18nl14n + is_uni_alnum + is_uni_alnum_lc + is_uni_alnumc + is_uni_alnumc_lc + is_uni_alpha + is_uni_alpha_lc + is_uni_ascii + is_uni_ascii_lc + is_uni_cntrl + is_uni_cntrl_lc + is_uni_digit + is_uni_digit_lc + is_uni_graph + is_uni_graph_lc + is_uni_idfirst + is_uni_idfirst_lc + is_uni_lower + is_uni_lower_lc + is_uni_print + is_uni_print_lc + is_uni_punct + is_uni_punct_lc + is_uni_space + is_uni_space_lc + is_uni_upper + is_uni_upper_lc + is_uni_xdigit + is_uni_xdigit_lc + is_utf8_alnum + is_utf8_alnumc + is_utf8_alpha + is_utf8_ascii + is_utf8_char + is_utf8_cntrl + is_utf8_digit + is_utf8_graph + is_utf8_idfirst + is_utf8_lower + is_utf8_mark + is_utf8_print + is_utf8_punct + is_utf8_space + is_utf8_upper + is_utf8_xdigit + load_module + magic_dump + mess + my_atof + my_fflush_all + newANONATTRSUB + newATTRSUB + newMYSUB + newPADOP + newXS + newXSproto + new_collate + new_ctype + new_numeric + op_dump + perl_parse + pmop_dump + pv_display + re_intuit_start + re_intuit_string + reginitcolors + require_pv + safesyscalloc + safesysfree + safesysmalloc + safesysrealloc + save_I8 + save_alloc + save_destructor + save_destructor_x + save_re_context + save_vptr + scan_bin + set_context + set_numeric_local + set_numeric_radix + set_numeric_standard + str_to_version + sv_2pvutf8 + sv_2pvutf8_nolen + sv_force_normal + sv_len_utf8 + sv_pos_b2u + sv_pos_u2b + sv_pv + sv_pvbyte + sv_pvbyten + sv_pvbyten_force + sv_pvutf8 + sv_pvutf8n + sv_pvutf8n_force + sv_rvweaken + sv_utf8_decode + sv_utf8_downgrade + sv_utf8_encode + swash_init + tmps_grow + to_uni_lower_lc + to_uni_title_lc + to_uni_upper_lc + utf8_distance + utf8_hop + vcroak + vform + vload_module + vmess + vwarn + vwarner + warner + +=item perl 5.005_03 + + POPpx + get_vtbl + save_generic_svref + +=item perl 5.005 + + PL_modglobal + cx_dump + debop + debprofdump + fbm_compile + fbm_instr + get_op_descs + get_op_names + init_stacks + mg_length + mg_size + newHVhv + new_stackinfo + regdump + regexec_flags + regnext + runops_debug + runops_standard + save_hints + save_iv + save_threadsv + screaminstr + sv_iv + sv_nv + sv_peek + sv_true + +=item perl 5.004_05 + + do_binmode + save_aelem + save_helem + +=item perl 5.004_04 + + newWHILEOP + +=item perl 5.004 + + GIMME_V + G_VOID + HEf_SVKEY + HeHASH + HeKEY + HeKLEN + HePV + HeSVKEY + HeSVKEY_force + HeSVKEY_set + HeVAL + SvSetMagicSV + SvSetMagicSV_nosteal + SvSetSV_nosteal + SvTAINTED + SvTAINTED_off + SvTAINTED_on + block_gimme + call_list + cv_const_sv + delimcpy + do_open + form + gv_autoload4 + gv_efullname3 + gv_fetchmethod_autoload + gv_fullname3 + hv_delayfree_ent + hv_delete_ent + hv_exists_ent + hv_fetch_ent + hv_free_ent + hv_iterkeysv + hv_ksplit + hv_store_ent + ibcmp_locale + my_failure_exit + my_memcmp + my_pclose + my_popen + newSVpvf + rsignal + rsignal_state + save_I16 + save_gp + start_subparse + sv_catpvf + sv_catpvf_mg + sv_cmp_locale + sv_derived_from + sv_gets + sv_setpvf + sv_setpvf_mg + sv_taint + sv_tainted + sv_untaint + sv_vcatpvf + sv_vcatpvf_mg + sv_vcatpvfn + sv_vsetpvf + sv_vsetpvf_mg + sv_vsetpvfn + unsharepvn + vnewSVpvf + +=back + +=head1 BUGS + +If you find any bugs, C<Devel::PPPort> doesn't seem to build on your +system or any of its tests fail, please use the CPAN Request Tracker +at L<http://rt.cpan.org/> to create a ticket for the module. + +=head1 AUTHORS + +=over 2 + +=item * Version 1.x of Devel::PPPort was written by Kenneth Albanowski. +=item * + Version 2.x was ported to the Perl core by Paul Marquess. +=item * + +Version 3.x was ported back to CPAN by Marcus Holland-Moritz. + +=back + +=head1 COPYRIGHT + +Version 3.x, Copyright (C) 2004, Marcus Holland-Moritz. + +Version 2.x, Copyright (C) 2001, Paul Marquess. + +Version 1.x, Copyright (C) 1999, Kenneth Albanowski. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + =head1 SEE ALSO -See L<h2xs>. +See L<h2xs>, L<ppport.h>. =cut - package Devel::PPPort; -require Exporter; require DynaLoader; -#use warnings; use strict; -use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK $data ); +use vars qw($VERSION @ISA $data); -$VERSION = "2.011"; +$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.03 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; -@ISA = qw(Exporter DynaLoader); -@EXPORT = qw(); -# Other items we are prepared to export if requested -@EXPORT_OK = qw( ); +@ISA = qw(DynaLoader); bootstrap Devel::PPPort; -package Devel::PPPort; - { - local $/ = undef; - $data = <DATA> ; - my $now = localtime; - my $pkg = __PACKAGE__; - $data =~ s/__VERSION__/$VERSION/g; - $data =~ s/__DATE__/$now/g; - $data =~ s/__PKG__/$pkg/g; + $data = do { local $/; <DATA> }; + my $now = localtime; + my $pkg = 'Devel::PPPort'; + $data =~ s/__PERL_VERSION__/$]/g; + $data =~ s/__VERSION__/$VERSION/g; + $data =~ s/__DATE__/$now/g; + $data =~ s/__PKG__/$pkg/g; + $data =~ s/^POD\s//gm; } sub WriteFile { - my $file = shift || 'ppport.h' ; + my $file = shift || 'ppport.h'; + my $copy = $data; + $copy =~ s/\bppport\.h\b/$file/g; - open F, ">$file" || return undef ; - print F $data ; - close F; + open F, ">$file" or return undef; + print F $copy; + close F; - return 1 ; + return 1; } 1; -__DATA__; +__DATA__ +#if 0 +<<'SKIP'; +#endif +/* +---------------------------------------------------------------------- -/* ppport.h -- Perl/Pollution/Portability Version __VERSION__ - * - * Automatically Created by __PKG__ on __DATE__ - * - * Do NOT edit this file directly! -- Edit PPPort.pm instead. - * - * Version 2.x, Copyright (C) 2001, Paul Marquess. - * Version 1.x, Copyright (C) 1999, Kenneth Albanowski. - * This code may be used and distributed under the same license as any - * version of Perl. - * - * This version of ppport.h is designed to support operation with Perl - * installations back to 5.004, and has been tested up to 5.8.1. - * - * If this version of ppport.h is failing during the compilation of this - * module, please check if a newer version of Devel::PPPort is available - * on CPAN before sending a bug report. - * - * If you are using the latest version of Devel::PPPort and it is failing - * during compilation of this module, please send a report to perlbug@perl.com - * - * Include all following information: - * - * 1. The complete output from running "perl -V" - * - * 2. This file. - * - * 3. The name & version of the module you were trying to build. - * - * 4. A full log of the build that failed. - * - * 5. Any other information that you think could be relevant. - * - * - * For the latest version of this code, please retreive the Devel::PPPort - * module from CPAN. - * - */ + ppport.h -- Perl/Pollution/Portability Version __VERSION__ + + Automatically created by __PKG__ running under + perl __PERL_VERSION__ on __DATE__. + + Do NOT edit this file directly! -- Edit PPPort_pm.PL and the + includes in parts/inc/ instead. + + Use 'perldoc ppport.h' to view the documentation below. + +---------------------------------------------------------------------- + +SKIP + +POD =pod +POD +POD =head1 NAME +POD +POD ppport.h - Perl/Pollution/Portability version __VERSION__ +POD +POD =head1 SYNOPSIS +POD +POD perl ppport.h [options] [files] +POD +POD --help show short help +POD +POD --patch=file write one patch file with changes +POD --copy=suffix write changed copies with suffix +POD --diff=program use diff program and options +POD +POD --compat-version=version provide compatibility with Perl version +POD --cplusplus accept C++ comments +POD +POD --quiet don't output anything except fatal errors +POD --nodiag don't show diagnostics +POD --nohints don't show hints +POD --nochanges don't suggest changes +POD +POD --list-provided list provided API +POD --list-unsupported list unsupported API +POD +POD =head1 COMPATIBILITY +POD +POD This version of F<ppport.h> is designed to support operation with Perl +POD installations back to 5.003, and has been tested up to 5.9.2. +POD +POD =head1 OPTIONS +POD +POD =head2 --help +POD +POD Display a brief usage summary. +POD +POD =head2 --patch=I<file> +POD +POD If this option is given, a single patch file will be created if +POD any changes are suggested. This requires a working diff program +POD to be installed on your system. +POD +POD =head2 --copy=I<suffix> +POD +POD If this option is given, a copy of each file will be saved with +POD the given suffix that contains the suggested changes. This does +POD not require any external programs. +POD +POD If neither C<--patch> or C<--copy> are given, the default is to +POD simply print the diffs for each file. This requires either +POD C<Text::Diff> or a C<diff> program to be installed. +POD +POD =head2 --diff=I<program> +POD +POD Manually set the diff program and options to use. The default +POD is to use C<Text::Diff>, when installed, and output unified +POD context diffs. +POD +POD =head2 --compat-version=I<version> +POD +POD Tell F<ppport.h> to check for compatibility with the given +POD Perl version. The default is to check for compatibility with Perl +POD version 5.003. You can use this option to reduce the output +POD of F<ppport.h> if you intend to be backward compatible only +POD up to a certain Perl version. +POD +POD =head2 --cplusplus +POD +POD Usually, F<ppport.h> will detect C++ style comments and +POD replace them with C style comments for portability reasons. +POD Using this option instructs F<ppport.h> to leave C++ +POD comments untouched. +POD +POD =head2 --quiet +POD +POD Be quiet. Don't print anything except fatal errors. +POD +POD =head2 --nodiag +POD +POD Don't output any diagnostic messages. Only portability +POD alerts will be printed. +POD +POD =head2 --nohints +POD +POD Don't output any hints. Hints often contain useful portability +POD notes. +POD +POD =head2 --nochanges +POD +POD Don't suggest any changes. Only give diagnostic output and hints +POD unless these are also deactivated. +POD +POD =head2 --list-provided +POD +POD Lists the API elements for which compatibility is provided by +POD F<ppport.h>. Also lists if it must be explicitly requested, +POD if it has dependencies, and if there are hints for it. +POD +POD =head2 --list-unsupported +POD +POD Lists the API elements that are known not to be supported by +POD F<ppport.h> and below which version of Perl they probably +POD won't be available or work. +POD +POD =head1 DESCRIPTION +POD +POD In order for a Perl extension (XS) module to be as portable as possible +POD across differing versions of Perl itself, certain steps need to be taken. +POD +POD =over 4 +POD +POD =item * +POD +POD Including this header is the first major one. This alone will give you +POD access to a large part of the Perl API that hasn't been available in +POD earlier Perl releases. Use +POD +POD perl ppport.h --list-provided +POD +POD to see which API elements are provided by ppport.h. +POD +POD =item * +POD +POD You should avoid using deprecated parts of the API. For example, using +POD global Perl variables without the C<PL_> prefix is deprecated. Also, +POD some API functions used to have a C<perl_> prefix. Using this form is +POD also deprecated. You can safely use the supported API, as F<ppport.h> +POD will provide wrappers for older Perl versions. +POD +POD =item * +POD +POD If you use one of a few functions that were not present in earlier +POD versions of Perl, and that can't be provided using a macro, you have +POD to explicitly request support for these functions by adding one or +POD more C<#define>s in your source code before the inclusion of F<ppport.h>. +POD +POD These functions will be marked C<explicit> in the list shown by +POD C<--list-provided>. +POD +POD Depending on whether you module has a single or multiple files that +POD use such functions, you want either C<static> or global variants. +POD +POD For a C<static> function, use: +POD +POD #define NEED_function +POD +POD For a global function, use: +POD +POD #define NEED_function_GLOBAL +POD +POD Note that you mustn't have more than one global request for one +POD function in your project. +POD +POD Function Static Request Global Request +POD ----------------------------------------------------------------------------------------- +POD eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL +POD grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL +POD grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL +POD grok_number() NEED_grok_number NEED_grok_number_GLOBAL +POD grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL +POD grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL +POD newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL +POD newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL +POD sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL +POD sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL +POD sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL +POD sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL +POD sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL +POD sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL +POD vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL +POD +POD To avoid namespace conflicts, you can change the namespace of the +POD explicitly exported functions using the C<DPPP_NAMESPACE> macro. +POD Just C<#define> the macro before including C<ppport.h>: +POD +POD #define DPPP_NAMESPACE MyOwnNamespace_ +POD #include "ppport.h" +POD +POD The default namespace is C<DPPP_>. +POD +POD =back +POD +POD The good thing is that most of the above can be checked by running +POD F<ppport.h> on your source code. See the next section for +POD details. +POD +POD =head1 EXAMPLES +POD +POD To verify whether F<ppport.h> is needed for your module, whether you +POD should make any changes to your code, and whether any special defines +POD should be used, F<ppport.h> can be run as a Perl script to check your +POD source code. Simply say: +POD +POD perl ppport.h +POD +POD The result will usually be a list of patches suggesting changes +POD that should at least be acceptable, if not necessarily the most +POD efficient solution, or a fix for all possible problems. +POD +POD If you know that your XS module uses features only available in +POD newer Perl releases, if you're aware that it uses C++ comments, +POD and if you want all suggestions as a single patch file, you could +POD use something like this: +POD +POD perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff +POD +POD If you only want your code to be scanned without any suggestions +POD for changes, use: +POD +POD perl ppport.h --nochanges +POD +POD You can specify a different C<diff> program or options, using +POD the C<--diff> option: +POD +POD perl ppport.h --diff='diff -C 10' +POD +POD This would output context diffs with 10 lines of context. +POD +POD =head1 BUGS +POD +POD If this version of F<ppport.h> is causing failure during +POD the compilation of this module, please check if newer versions +POD of either this module or C<Devel::PPPort> are available on CPAN +POD before sending a bug report. +POD +POD If F<ppport.h> was generated using the latest version of +POD C<Devel::PPPort> and is causing failure of this module, please +POD file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>. +POD +POD Please include the following information: +POD +POD =over 4 +POD +POD =item 1. +POD +POD The complete output from running "perl -V" +POD +POD =item 2. +POD +POD This file. +POD +POD =item 3. +POD +POD The name and version of the module you were trying to build. +POD +POD =item 4. +POD +POD A full log of the build that failed. +POD +POD =item 5. +POD +POD Any other information that you think could be relevant. +POD +POD =back +POD +POD For the latest version of this code, please get the C<Devel::PPPort> +POD module from CPAN. +POD +POD =head1 COPYRIGHT +POD +POD Version 3.x, Copyright (c) 2004, Marcus Holland-Moritz. +POD +POD Version 2.x, Copyright (C) 2001, Paul Marquess. +POD +POD Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +POD +POD This program is free software; you can redistribute it and/or +POD modify it under the same terms as Perl itself. +POD +POD =head1 SEE ALSO +POD +POD See L<Devel::PPPort>. -/* - * In order for a Perl extension module to be as portable as possible - * across differing versions of Perl itself, certain steps need to be taken. - * Including this header is the first major one, then using dTHR is all the - * appropriate places and using a PL_ prefix to refer to global Perl - * variables is the second. - * - */ +=cut +use strict; -/* If you use one of a few functions that were not present in earlier - * versions of Perl, please add a define before the inclusion of ppport.h - * for a static include, or use the GLOBAL request in a single module to - * produce a global definition that can be referenced from the other - * modules. - * - * Function: Static define: Extern define: - * newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL - * - */ - +my %opt = ( + quiet => 0, + diag => 1, + hints => 1, + changes => 1, + cplusplus => 0, +); + +my($ppport) = $0 =~ /([\w.]+)$/; +my $LF = '(?:\r\n|[\r\n])'; # line feed +my $HS = "[ \t]"; # horizontal whitespace + +eval { + require Getopt::Long; + Getopt::Long::GetOptions(\%opt, qw( + help quiet diag! hints! changes! cplusplus + patch=s copy=s diff=s compat-version=s + list-provided list-unsupported + )) or usage(); +}; + +if ($@ and grep /^-/, @ARGV) { + usage() if "@ARGV" =~ /^--?h(?:elp)?$/; + die "Getopt::Long not found. Please don't use any options.\n"; +} -/* To verify whether ppport.h is needed for your module, and whether any - * special defines should be used, ppport.h can be run through Perl to check - * your source code. Simply say: - * - * perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc] - * - * The result will be a list of patches suggesting changes that should at - * least be acceptable, if not necessarily the most efficient solution, or a - * fix for all possible problems. It won't catch where dTHR is needed, and - * doesn't attempt to account for global macro or function definitions, - * nested includes, typemaps, etc. - * - * In order to test for the need of dTHR, please try your module under a - * recent version of Perl that has threading compiled-in. - * - */ +usage() if $opt{help}; +if (exists $opt{'compat-version'}) { + my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) }; + if ($@) { + die "Invalid version number format: '$opt{'compat-version'}'\n"; + } + die "Only Perl 5 is supported\n" if $r != 5; + die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $v >= 1000; + $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s; +} +else { + $opt{'compat-version'} = 5; +} -/* -#!/usr/bin/perl -@ARGV = ("*.xs") if !@ARGV; -%badmacros = %funcs = %macros = (); $replace = 0; -foreach (<DATA>) { - $funcs{$1} = 1 if /Provide:\s+(\S+)/; - $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/; - $replace = $1 if /Replace:\s+(\d+)/; - $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/; - $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/; +# Never use C comments in this file!!!!! +my $ccs = '/'.'*'; +my $cce = '*'.'/'; +my $rccs = quotemeta $ccs; +my $rcce = quotemeta $cce; + +my @files; + +if (@ARGV) { + @files = map { glob $_ } @ARGV; +} +else { + eval { + require File::Find; + File::Find::find(sub { + $File::Find::name =~ /\.(xs|c|h|cc)$/i + and push @files, $File::Find::name; + }, '.'); + }; + if ($@) { + @files = map { glob $_ } qw(*.xs *.c *.h *.cc); + } + my %filter = map { /(.*)\.xs$/ ? ("$1.c" => 1) : () } @files; + @files = grep { !/\b\Q$ppport\E$/i && !exists $filter{$_} } @files; } -foreach $filename (map(glob($_),@ARGV)) { - unless (open(IN, "<$filename")) { - warn "Unable to read from $file: $!\n"; - next; - } - print "Scanning $filename...\n"; - $c = ""; while (<IN>) { $c .= $_; } close(IN); - $need_include = 0; %add_func = (); $changes = 0; - $has_include = ($c =~ /#.*include.*ppport/m); - - foreach $func (keys %funcs) { - if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) { - if ($c !~ /\b$func\b/m) { - print "If $func isn't needed, you don't need to request it.\n" if - $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m); - } else { - print "Uses $func\n"; - $need_include = 1; - } - } else { - if ($c =~ /\b$func\b/m) { - $add_func{$func} =1 ; - print "Uses $func\n"; - $need_include = 1; - } - } - } - if (not $need_include) { - foreach $macro (keys %macros) { - if ($c =~ /\b$macro\b/m) { - print "Uses $macro\n"; - $need_include = 1; - } - } - } +unless (@files) { + die "No input files given!\n"; +} - foreach $badmacro (keys %badmacros) { - if ($c =~ /\b$badmacro\b/m) { - $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm); - print "Uses $badmacros{$badmacro} (instead of $badmacro)\n"; - $need_include = 1; - } - } - - if (scalar(keys %add_func) or $need_include != $has_include) { - if (!$has_include) { - $inc = join('',map("#define NEED_$_\n", sort keys %add_func)). - "#include \"ppport.h\"\n"; - $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m; - } elsif (keys %add_func) { - $inc = join('',map("#define NEED_$_\n", sort keys %add_func)); - $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m; - } - if (!$need_include) { - print "Doesn't seem to need ppport.h.\n"; - $c =~ s/^.*#.*include.*ppport.*\n//m; - } - $changes++; - } - - if ($changes) { - open(OUT,">/tmp/ppport.h.$$"); - print OUT $c; - close(OUT); - open(DIFF, "diff -u $filename /tmp/ppport.h.$$|"); - while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; } - close(DIFF); - unlink("/tmp/ppport.h.$$"); - } else { - print "Looks OK\n"; - } +my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/ + ? ( $1 => { + ($2 ? ( base => $2 ) : ()), + ($3 ? ( todo => $3 ) : ()), + (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()), + (index($4, 'p') >= 0 ? ( provided => 1 ) : ()), + (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()), + } ) + : die "invalid spec: $_" } qw( +AvFILLp|5.004050||p +AvFILL||| +CLASS|||n +CX_CURPAD_SAVE||| +CX_CURPAD_SV||| +CopFILEAV|5.006000||p +CopFILEGV_set|5.006000||p +CopFILEGV|5.006000||p +CopFILESV|5.006000||p +CopFILE_set|5.006000||p +CopFILE|5.006000||p +CopSTASHPV_set|5.006000||p +CopSTASHPV|5.006000||p +CopSTASH_eq|5.006000||p +CopSTASH_set|5.006000||p +CopSTASH|5.006000||p +CopyD|5.009002||p +Copy||| +CvPADLIST||| +CvSTASH||| +CvWEAKOUTSIDE||| +DEFSV|5.004050||p +END_EXTERN_C|5.005000||p +ENTER||| +ERRSV|5.004050||p +EXTEND||| +EXTERN_C|5.005000||p +FREETMPS||| +GIMME_V||5.004000|n +GIMME|||n +GROK_NUMERIC_RADIX|5.007002||p +G_ARRAY||| +G_DISCARD||| +G_EVAL||| +G_NOARGS||| +G_SCALAR||| +G_VOID||5.004000| +GetVars||| +GvSV||| +Gv_AMupdate||| +HEf_SVKEY||5.004000| +HeHASH||5.004000| +HeKEY||5.004000| +HeKLEN||5.004000| +HePV||5.004000| +HeSVKEY_force||5.004000| +HeSVKEY_set||5.004000| +HeSVKEY||5.004000| +HeVAL||5.004000| +HvNAME||| +INT2PTR|5.006000||p +IN_LOCALE_COMPILETIME|5.007002||p +IN_LOCALE_RUNTIME|5.007002||p +IN_LOCALE|5.007002||p +IN_PERL_COMPILETIME|5.008001||p +IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p +IS_NUMBER_INFINITY|5.007002||p +IS_NUMBER_IN_UV|5.007002||p +IS_NUMBER_NAN|5.007003||p +IS_NUMBER_NEG|5.007002||p +IS_NUMBER_NOT_INT|5.007002||p +IVSIZE|5.006000||p +IVTYPE|5.006000||p +IVdf|5.006000||p +LEAVE||| +LVRET||| +MARK||| +MY_CXT_CLONE|5.009002||p +MY_CXT_INIT|5.007003||p +MY_CXT|5.007003||p +MoveD|5.009002||p +Move||| +NEWSV||| +NOOP|5.005000||p +NUM2PTR|5.006000||p +NVTYPE|5.006000||p +NVef|5.006001||p +NVff|5.006001||p +NVgf|5.006001||p +Newc||| +Newz||| +New||| +Nullav||| +Nullch||| +Nullcv||| +Nullhv||| +Nullsv||| +ORIGMARK||| +PAD_BASE_SV||| +PAD_CLONE_VARS||| +PAD_COMPNAME_FLAGS||| +PAD_COMPNAME_GEN||| +PAD_COMPNAME_OURSTASH||| +PAD_COMPNAME_PV||| +PAD_COMPNAME_TYPE||| +PAD_RESTORE_LOCAL||| +PAD_SAVE_LOCAL||| +PAD_SAVE_SETNULLPAD||| +PAD_SETSV||| +PAD_SET_CUR_NOSAVE||| +PAD_SET_CUR||| +PAD_SVl||| +PAD_SV||| +PERL_BCDVERSION|5.009002||p +PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p +PERL_INT_MAX|5.004000||p +PERL_INT_MIN|5.004000||p +PERL_LONG_MAX|5.004000||p +PERL_LONG_MIN|5.004000||p +PERL_MAGIC_arylen|5.007002||p +PERL_MAGIC_backref|5.007002||p +PERL_MAGIC_bm|5.007002||p +PERL_MAGIC_collxfrm|5.007002||p +PERL_MAGIC_dbfile|5.007002||p +PERL_MAGIC_dbline|5.007002||p +PERL_MAGIC_defelem|5.007002||p +PERL_MAGIC_envelem|5.007002||p +PERL_MAGIC_env|5.007002||p +PERL_MAGIC_ext|5.007002||p +PERL_MAGIC_fm|5.007002||p +PERL_MAGIC_glob|5.007002||p +PERL_MAGIC_isaelem|5.007002||p +PERL_MAGIC_isa|5.007002||p +PERL_MAGIC_mutex|5.007002||p +PERL_MAGIC_nkeys|5.007002||p +PERL_MAGIC_overload_elem|5.007002||p +PERL_MAGIC_overload_table|5.007002||p +PERL_MAGIC_overload|5.007002||p +PERL_MAGIC_pos|5.007002||p +PERL_MAGIC_qr|5.007002||p +PERL_MAGIC_regdata|5.007002||p +PERL_MAGIC_regdatum|5.007002||p +PERL_MAGIC_regex_global|5.007002||p +PERL_MAGIC_shared_scalar|5.007003||p +PERL_MAGIC_shared|5.007003||p +PERL_MAGIC_sigelem|5.007002||p +PERL_MAGIC_sig|5.007002||p +PERL_MAGIC_substr|5.007002||p +PERL_MAGIC_sv|5.007002||p +PERL_MAGIC_taint|5.007002||p +PERL_MAGIC_tiedelem|5.007002||p +PERL_MAGIC_tiedscalar|5.007002||p +PERL_MAGIC_tied|5.007002||p +PERL_MAGIC_utf8|5.008001||p +PERL_MAGIC_uvar_elem|5.007003||p +PERL_MAGIC_uvar|5.007002||p +PERL_MAGIC_vec|5.007002||p +PERL_MAGIC_vstring|5.008001||p +PERL_QUAD_MAX|5.004000||p +PERL_QUAD_MIN|5.004000||p +PERL_REVISION|5.006000||p +PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p +PERL_SCAN_DISALLOW_PREFIX|5.007003||p +PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p +PERL_SCAN_SILENT_ILLDIGIT|5.008001||p +PERL_SHORT_MAX|5.004000||p +PERL_SHORT_MIN|5.004000||p +PERL_SUBVERSION|5.006000||p +PERL_UCHAR_MAX|5.004000||p +PERL_UCHAR_MIN|5.004000||p +PERL_UINT_MAX|5.004000||p +PERL_UINT_MIN|5.004000||p +PERL_ULONG_MAX|5.004000||p +PERL_ULONG_MIN|5.004000||p +PERL_UNUSED_DECL|5.007002||p +PERL_UQUAD_MAX|5.004000||p +PERL_UQUAD_MIN|5.004000||p +PERL_USHORT_MAX|5.004000||p +PERL_USHORT_MIN|5.004000||p +PERL_VERSION|5.006000||p +PL_DBsingle|||pn +PL_DBsub|||pn +PL_DBtrace|||n +PL_Sv|5.005000||p +PL_compiling|5.004050||p +PL_copline|5.005000||p +PL_curcop|5.004050||p +PL_curstash|5.004050||p +PL_debstash|5.004050||p +PL_defgv|5.004050||p +PL_diehook|5.004050||p +PL_dirty|5.004050||p +PL_dowarn|||pn +PL_errgv|5.004050||p +PL_hexdigit|5.005000||p +PL_hints|5.005000||p +PL_last_in_gv|||n +PL_modglobal||5.005000|n +PL_na|5.004050||pn +PL_no_modify|5.006000||p +PL_ofs_sv|||n +PL_perl_destruct_level|5.004050||p +PL_perldb|5.004050||p +PL_ppaddr|5.006000||p +PL_rsfp_filters|5.004050||p +PL_rsfp|5.004050||p +PL_rs|||n +PL_stack_base|5.004050||p +PL_stack_sp|5.004050||p +PL_stdingv|5.004050||p +PL_sv_arenaroot|5.004050||p +PL_sv_no|5.004050||pn +PL_sv_undef|5.004050||pn +PL_sv_yes|5.004050||pn +PL_tainted|5.004050||p +PL_tainting|5.004050||p +POPi|||n +POPl|||n +POPn|||n +POPpbytex||5.007001|n +POPpx||5.005030|n +POPp|||n +POPs|||n +PTR2IV|5.006000||p +PTR2NV|5.006000||p +PTR2UV|5.006000||p +PTR2ul|5.007001||p +PTRV|5.006000||p +PUSHMARK||| +PUSHi||| +PUSHmortal|5.009002||p +PUSHn||| +PUSHp||| +PUSHs||| +PUSHu|5.004000||p +PUTBACK||| +PerlIO_clearerr||5.007003| +PerlIO_close||5.007003| +PerlIO_eof||5.007003| +PerlIO_error||5.007003| +PerlIO_fileno||5.007003| +PerlIO_fill||5.007003| +PerlIO_flush||5.007003| +PerlIO_get_base||5.007003| +PerlIO_get_bufsiz||5.007003| +PerlIO_get_cnt||5.007003| +PerlIO_get_ptr||5.007003| +PerlIO_read||5.007003| +PerlIO_seek||5.007003| +PerlIO_set_cnt||5.007003| +PerlIO_set_ptrcnt||5.007003| +PerlIO_setlinebuf||5.007003| +PerlIO_stderr||5.007003| +PerlIO_stdin||5.007003| +PerlIO_stdout||5.007003| +PerlIO_tell||5.007003| +PerlIO_unread||5.007003| +PerlIO_write||5.007003| +Poison|5.008000||p +RETVAL|||n +Renewc||| +Renew||| +SAVECLEARSV||| +SAVECOMPPAD||| +SAVEPADSV||| +SAVETMPS||| +SAVE_DEFSV|5.004050||p +SPAGAIN||| +SP||| +START_EXTERN_C|5.005000||p +START_MY_CXT|5.007003||p +STMT_END|||p +STMT_START|||p +ST||| +SVt_IV||| +SVt_NV||| +SVt_PVAV||| +SVt_PVCV||| +SVt_PVHV||| +SVt_PVMG||| +SVt_PV||| +Safefree||| +Slab_Alloc||| +Slab_Free||| +StructCopy||| +SvCUR_set||| +SvCUR||| +SvEND||| +SvGETMAGIC|5.004050||p +SvGROW||| +SvIOK_UV||5.006000| +SvIOK_notUV||5.006000| +SvIOK_off||| +SvIOK_only_UV||5.006000| +SvIOK_only||| +SvIOK_on||| +SvIOKp||| +SvIOK||| +SvIVX||| +SvIV_nomg|5.009001||p +SvIVx||| +SvIV||| +SvIsCOW_shared_hash||5.008003| +SvIsCOW||5.008003| +SvLEN||| +SvLOCK||5.007003| +SvNIOK_off||| +SvNIOKp||| +SvNIOK||| +SvNOK_off||| +SvNOK_only||| +SvNOK_on||| +SvNOKp||| +SvNOK||| +SvNVX||| +SvNVx||| +SvNV||| +SvOK||| +SvOOK||| +SvPOK_off||| +SvPOK_only_UTF8||5.006000| +SvPOK_only||| +SvPOK_on||| +SvPOKp||| +SvPOK||| +SvPVX||| +SvPV_force_nomg|5.007002||p +SvPV_force||| +SvPV_nolen|5.006000||p +SvPV_nomg|5.007002||p +SvPVbyte_force||5.009002| +SvPVbyte_nolen||5.006000| +SvPVbytex_force||5.006000| +SvPVbytex||5.006000| +SvPVbyte|5.006000||p +SvPVutf8_force||5.006000| +SvPVutf8_nolen||5.006000| +SvPVutf8x_force||5.006000| +SvPVutf8x||5.006000| +SvPVutf8||5.006000| +SvPVx||| +SvPV||| +SvREFCNT_dec||| +SvREFCNT_inc||| +SvREFCNT||| +SvROK_off||| +SvROK_on||| +SvROK||| +SvRV||| +SvSETMAGIC||| +SvSHARE||5.007003| +SvSTASH||| +SvSetMagicSV_nosteal||5.004000| +SvSetMagicSV||5.004000| +SvSetSV_nosteal||5.004000| +SvSetSV||| +SvTAINTED_off||5.004000| +SvTAINTED_on||5.004000| +SvTAINTED||5.004000| +SvTAINT||| +SvTRUE||| +SvTYPE||| +SvUNLOCK||5.007003| +SvUOK||5.007001| +SvUPGRADE||| +SvUTF8_off||5.006000| +SvUTF8_on||5.006000| +SvUTF8||5.006000| +SvUVXx|5.004000||p +SvUVX|5.004000||p +SvUV_nomg|5.009001||p +SvUVx|5.004000||p +SvUV|5.004000||p +SvVOK||5.008001| +THIS|||n +UNDERBAR|5.009002||p +UVSIZE|5.006000||p +UVTYPE|5.006000||p +UVXf|5.007001||p +UVof|5.006000||p +UVuf|5.006000||p +UVxf|5.006000||p +XPUSHi||| +XPUSHmortal|5.009002||p +XPUSHn||| +XPUSHp||| +XPUSHs||| +XPUSHu|5.004000||p +XSRETURN_EMPTY||| +XSRETURN_IV||| +XSRETURN_NO||| +XSRETURN_NV||| +XSRETURN_PV||| +XSRETURN_UNDEF||| +XSRETURN_UV|5.008001||p +XSRETURN_YES||| +XSRETURN||| +XST_mIV||| +XST_mNO||| +XST_mNV||| +XST_mPV||| +XST_mUNDEF||| +XST_mUV|5.008001||p +XST_mYES||| +XS_VERSION_BOOTCHECK||| +XS_VERSION||| +XS||| +ZeroD|5.009002||p +Zero||| +_aMY_CXT|5.007003||p +_pMY_CXT|5.007003||p +aMY_CXT_|5.007003||p +aMY_CXT|5.007003||p +aTHX_|5.006000||p +aTHX|5.006000||p +add_data||| +allocmy||| +amagic_call||| +any_dup||| +ao||| +append_elem||| +append_list||| +apply_attrs_my||| +apply_attrs_string||5.006001| +apply_attrs||| +apply||| +asIV||| +asUV||| +atfork_lock||5.007003|n +atfork_unlock||5.007003|n +av_clear||| +av_delete||5.006000| +av_exists||5.006000| +av_extend||| +av_fake||| +av_fetch||| +av_fill||| +av_len||| +av_make||| +av_pop||| +av_push||| +av_reify||| +av_shift||| +av_store||| +av_undef||| +av_unshift||| +ax|||n +bad_type||| +bind_match||| +block_end||| +block_gimme||5.004000| +block_start||| +boolSV|5.004000||p +boot_core_PerlIO||| +boot_core_UNIVERSAL||| +boot_core_xsutils||| +bytes_from_utf8||5.007001| +bytes_to_utf8||5.006001| +cache_re||| +call_argv|5.006000||p +call_atexit||5.006000| +call_body||| +call_list_body||| +call_list||5.004000| +call_method|5.006000||p +call_pv|5.006000||p +call_sv|5.006000||p +calloc||5.007002|n +cando||| +cast_i32||5.006000| +cast_iv||5.006000| +cast_ulong||5.006000| +cast_uv||5.006000| +check_uni||| +checkcomma||| +checkposixcc||| +cl_and||| +cl_anything||| +cl_init_zero||| +cl_init||| +cl_is_anything||| +cl_or||| +closest_cop||| +convert||| +cop_free||| +cr_textfilter||| +croak_nocontext|||vn +croak|||v +csighandler||5.007001|n +custom_op_desc||5.007003| +custom_op_name||5.007003| +cv_ckproto||| +cv_clone||| +cv_const_sv||5.004000| +cv_dump||| +cv_undef||| +cx_dump||5.005000| +cx_dup||| +cxinc||| +dAX|5.007002||p +dITEMS|5.007002||p +dMARK||| +dMY_CXT_SV|5.007003||p +dMY_CXT|5.007003||p +dNOOP|5.006000||p +dORIGMARK||| +dSP||| +dTHR|5.004050||p +dTHXa|5.006000||p +dTHXoa|5.006000||p +dTHX|5.006000||p +dUNDERBAR|5.009002||p +dXSARGS||| +dXSI32||| +deb_curcv||| +deb_nocontext|||vn +deb_stack_all||| +deb_stack_n||| +debop||5.005000| +debprofdump||5.005000| +debprof||| +debstackptrs||5.007003| +debstack||5.007003| +deb||5.007003|v +default_protect|||v +del_he||| +del_sv||| +del_xiv||| +del_xnv||| +del_xpvav||| +del_xpvbm||| +del_xpvcv||| +del_xpvhv||| +del_xpviv||| +del_xpvlv||| +del_xpvmg||| +del_xpvnv||| +del_xpv||| +del_xrv||| +delimcpy||5.004000| +depcom||| +deprecate_old||| +deprecate||| +despatch_signals||5.007001| +die_nocontext|||vn +die_where||| +die|||v +dirp_dup||| +div128||| +djSP||| +do_aexec5||| +do_aexec||| +do_aspawn||| +do_binmode||5.004050| +do_chomp||| +do_chop||| +do_close||| +do_dump_pad||| +do_eof||| +do_exec3||| +do_execfree||| +do_exec||| +do_gv_dump||5.006000| +do_gvgv_dump||5.006000| +do_hv_dump||5.006000| +do_ipcctl||| +do_ipcget||| +do_join||| +do_kv||| +do_magic_dump||5.006000| +do_msgrcv||| +do_msgsnd||| +do_oddball||| +do_op_dump||5.006000| +do_open9||5.006000| +do_openn||5.007001| +do_open||5.004000| +do_pipe||| +do_pmop_dump||5.006000| +do_print||| +do_readline||| +do_seek||| +do_semop||| +do_shmio||| +do_spawn_nowait||| +do_spawn||| +do_sprintf||| +do_sv_dump||5.006000| +do_sysseek||| +do_tell||| +do_trans_complex_utf8||| +do_trans_complex||| +do_trans_count_utf8||| +do_trans_count||| +do_trans_simple_utf8||| +do_trans_simple||| +do_trans||| +do_vecget||| +do_vecset||| +do_vop||| +docatch_body||| +docatch||| +doencodes||| +doeval||| +dofile||| +dofindlabel||| +doform||| +doing_taint||5.008001|n +dooneliner||| +doopen_pm||| +doparseform||| +dopoptoeval||| +dopoptolabel||| +dopoptoloop||| +dopoptosub_at||| +dopoptosub||| +dounwind||| +dowantarray||| +dump_all||5.006000| +dump_eval||5.006000| +dump_fds||| +dump_form||5.006000| +dump_indent||5.006000|v +dump_mstats||| +dump_packsubs||5.006000| +dump_sub||5.006000| +dump_vindent||5.006000| +dumpuntil||| +dup_attrlist||| +emulate_eaccess||| +eval_pv|5.006000||p +eval_sv|5.006000||p +expect_number||| +fbm_compile||5.005000| +fbm_instr||5.005000| +fd_on_nosuid_fs||| +filter_add||| +filter_del||| +filter_gets||| +filter_read||| +find_beginning||| +find_byclass||| +find_in_my_stash||| +find_runcv||| +find_rundefsvoffset||5.009002| +find_script||| +find_uninit_var||| +fold_constants||| +forbid_setid||| +force_ident||| +force_list||| +force_next||| +force_version||| +force_word||| +form_nocontext|||vn +form||5.004000|v +fp_dup||| +fprintf_nocontext|||vn +free_tied_hv_pool||| +free_tmps||| +gen_constant_list||| +get_av|5.006000||p +get_context||5.006000|n +get_cv|5.006000||p +get_db_sub||| +get_debug_opts||| +get_hash_seed||| +get_hv|5.006000||p +get_mstats||| +get_no_modify||| +get_num||| +get_op_descs||5.005000| +get_op_names||5.005000| +get_opargs||| +get_ppaddr||5.006000| +get_sv|5.006000||p +get_vtbl||5.005030| +getcwd_sv||5.007002| +getenv_len||| +gp_dup||| +gp_free||| +gp_ref||| +grok_bin|5.007003||p +grok_hex|5.007003||p +grok_number|5.007002||p +grok_numeric_radix|5.007002||p +grok_oct|5.007003||p +group_end||| +gv_AVadd||| +gv_HVadd||| +gv_IOadd||| +gv_autoload4||5.004000| +gv_check||| +gv_dump||5.006000| +gv_efullname3||5.004000| +gv_efullname4||5.006001| +gv_efullname||| +gv_ename||| +gv_fetchfile||| +gv_fetchmeth_autoload||5.007003| +gv_fetchmethod_autoload||5.004000| +gv_fetchmethod||| +gv_fetchmeth||| +gv_fetchpv||| +gv_fullname3||5.004000| +gv_fullname4||5.006001| +gv_fullname||| +gv_handler||5.007001| +gv_init_sv||| +gv_init||| +gv_share||| +gv_stashpvn|5.006000||p +gv_stashpv||| +gv_stashsv||| +he_dup||| +hfreeentries||| +hsplit||| +hv_assert||5.009001| +hv_clear_placeholders||5.009001| +hv_clear||| +hv_delayfree_ent||5.004000| +hv_delete_common||| +hv_delete_ent||5.004000| +hv_delete||| +hv_exists_ent||5.004000| +hv_exists||| +hv_fetch_common||| +hv_fetch_ent||5.004000| +hv_fetch||| +hv_free_ent||5.004000| +hv_iterinit||| +hv_iterkeysv||5.004000| +hv_iterkey||| +hv_iternext_flags||5.008000| +hv_iternextsv||| +hv_iternext||| +hv_iterval||| +hv_ksplit||5.004000| +hv_magic_check||| +hv_magic||| +hv_notallowed||| +hv_scalar||5.009001| +hv_store_ent||5.004000| +hv_store_flags||5.008000| +hv_store||| +hv_undef||| +ibcmp_locale||5.004000| +ibcmp_utf8||5.007003| +ibcmp||| +incl_perldb||| +incline||| +incpush||| +ingroup||| +init_argv_symbols||| +init_debugger||| +init_i18nl10n||5.006000| +init_i18nl14n||5.006000| +init_ids||| +init_interp||| +init_lexer||| +init_main_stash||| +init_perllib||| +init_postdump_symbols||| +init_predump_symbols||| +init_stacks||5.005000| +init_tm||5.007002| +instr||| +intro_my||| +intuit_method||| +intuit_more||| +invert||| +io_close||| +isALNUM||| +isALPHA||| +isDIGIT||| +isLOWER||| +isSPACE||| +isUPPER||| +is_an_int||| +is_gv_magical||| +is_handle_constructor||| +is_lvalue_sub||5.007001| +is_uni_alnum_lc||5.006000| +is_uni_alnumc_lc||5.006000| +is_uni_alnumc||5.006000| +is_uni_alnum||5.006000| +is_uni_alpha_lc||5.006000| +is_uni_alpha||5.006000| +is_uni_ascii_lc||5.006000| +is_uni_ascii||5.006000| +is_uni_cntrl_lc||5.006000| +is_uni_cntrl||5.006000| +is_uni_digit_lc||5.006000| +is_uni_digit||5.006000| +is_uni_graph_lc||5.006000| +is_uni_graph||5.006000| +is_uni_idfirst_lc||5.006000| +is_uni_idfirst||5.006000| +is_uni_lower_lc||5.006000| +is_uni_lower||5.006000| +is_uni_print_lc||5.006000| +is_uni_print||5.006000| +is_uni_punct_lc||5.006000| +is_uni_punct||5.006000| +is_uni_space_lc||5.006000| +is_uni_space||5.006000| +is_uni_upper_lc||5.006000| +is_uni_upper||5.006000| +is_uni_xdigit_lc||5.006000| +is_uni_xdigit||5.006000| +is_utf8_alnumc||5.006000| +is_utf8_alnum||5.006000| +is_utf8_alpha||5.006000| +is_utf8_ascii||5.006000| +is_utf8_char||5.006000| +is_utf8_cntrl||5.006000| +is_utf8_digit||5.006000| +is_utf8_graph||5.006000| +is_utf8_idcont||5.008000| +is_utf8_idfirst||5.006000| +is_utf8_lower||5.006000| +is_utf8_mark||5.006000| +is_utf8_print||5.006000| +is_utf8_punct||5.006000| +is_utf8_space||5.006000| +is_utf8_string_loc||5.008001| +is_utf8_string||5.006001| +is_utf8_upper||5.006000| +is_utf8_xdigit||5.006000| +isa_lookup||| +items|||n +ix|||n +jmaybe||| +keyword||| +leave_scope||| +lex_end||| +lex_start||| +linklist||| +list_assignment||| +listkids||| +list||| +load_module_nocontext|||vn +load_module||5.006000|v +localize||| +looks_like_number||| +lop||| +mPUSHi|5.009002||p +mPUSHn|5.009002||p +mPUSHp|5.009002||p +mPUSHu|5.009002||p +mXPUSHi|5.009002||p +mXPUSHn|5.009002||p +mXPUSHp|5.009002||p +mXPUSHu|5.009002||p +magic_clear_all_env||| +magic_clearenv||| +magic_clearpack||| +magic_clearsig||| +magic_dump||5.006000| +magic_existspack||| +magic_freeovrld||| +magic_freeregexp||| +magic_getarylen||| +magic_getdefelem||| +magic_getglob||| +magic_getnkeys||| +magic_getpack||| +magic_getpos||| +magic_getsig||| +magic_getsubstr||| +magic_gettaint||| +magic_getuvar||| +magic_getvec||| +magic_get||| +magic_killbackrefs||| +magic_len||| +magic_methcall||| +magic_methpack||| +magic_nextpack||| +magic_regdata_cnt||| +magic_regdatum_get||| +magic_regdatum_set||| +magic_scalarpack||| +magic_set_all_env||| +magic_setamagic||| +magic_setarylen||| +magic_setbm||| +magic_setcollxfrm||| +magic_setdbline||| +magic_setdefelem||| +magic_setenv||| +magic_setfm||| +magic_setglob||| +magic_setisa||| +magic_setmglob||| +magic_setnkeys||| +magic_setpack||| +magic_setpos||| +magic_setregexp||| +magic_setsig||| +magic_setsubstr||| +magic_settaint||| +magic_setutf8||| +magic_setuvar||| +magic_setvec||| +magic_set||| +magic_sizepack||| +magic_wipepack||| +magicname||| +malloced_size|||n +malloc||5.007002|n +markstack_grow||| +measure_struct||| +memEQ|5.004000||p +memNE|5.004000||p +mem_collxfrm||| +mess_alloc||| +mess_nocontext|||vn +mess||5.006000|v +method_common||| +mfree||5.007002|n +mg_clear||| +mg_copy||| +mg_dup||| +mg_find||| +mg_free||| +mg_get||| +mg_length||5.005000| +mg_magical||| +mg_set||| +mg_size||5.005000| +mini_mktime||5.007002| +missingterm||| +mode_from_discipline||| +modkids||| +mod||| +more_he||| +more_sv||| +more_xiv||| +more_xnv||| +more_xpvav||| +more_xpvbm||| +more_xpvcv||| +more_xpvhv||| +more_xpviv||| +more_xpvlv||| +more_xpvmg||| +more_xpvnv||| +more_xpv||| +more_xrv||| +moreswitches||| +mul128||| +mulexp10|||n +my_atof2||5.007002| +my_atof||5.006000| +my_attrs||| +my_bcopy|||n +my_betoh16|||n +my_betoh32|||n +my_betoh64|||n +my_betohi|||n +my_betohl|||n +my_betohs|||n +my_bzero|||n +my_chsize||| +my_exit_jump||| +my_exit||| +my_failure_exit||5.004000| +my_fflush_all||5.006000| +my_fork||5.007003|n +my_htobe16|||n +my_htobe32|||n +my_htobe64|||n +my_htobei|||n +my_htobel|||n +my_htobes|||n +my_htole16|||n +my_htole32|||n +my_htole64|||n +my_htolei|||n +my_htolel|||n +my_htoles|||n +my_htonl||| +my_kid||| +my_letoh16|||n +my_letoh32|||n +my_letoh64|||n +my_letohi|||n +my_letohl|||n +my_letohs|||n +my_lstat||| +my_memcmp||5.004000|n +my_memset|||n +my_ntohl||| +my_pclose||5.004000| +my_popen_list||5.007001| +my_popen||5.004000| +my_setenv||| +my_socketpair||5.007003|n +my_stat||| +my_strftime||5.007002| +my_swabn|||n +my_swap||| +my_unexec||| +my||| +newANONATTRSUB||5.006000| +newANONHASH||| +newANONLIST||| +newANONSUB||| +newASSIGNOP||| +newATTRSUB||5.006000| +newAVREF||| +newAV||| +newBINOP||| +newCONDOP||| +newCONSTSUB|5.006000||p +newCVREF||| +newDEFSVOP||| +newFORM||| +newFOROP||| +newGVOP||| +newGVREF||| +newGVgen||| +newHVREF||| +newHVhv||5.005000| +newHV||| +newIO||| +newLISTOP||| +newLOGOP||| +newLOOPEX||| +newLOOPOP||| +newMYSUB||5.006000| +newNULLLIST||| +newOP||| +newPADOP||5.006000| +newPMOP||| +newPROG||| +newPVOP||| +newRANGE||| +newRV_inc|5.004000||p +newRV_noinc|5.006000||p +newRV||| +newSLICEOP||| +newSTATEOP||| +newSUB||| +newSVOP||| +newSVREF||| +newSViv||| +newSVnv||| +newSVpvf_nocontext|||vn +newSVpvf||5.004000|v +newSVpvn_share||5.007001| +newSVpvn|5.006000||p +newSVpv||| +newSVrv||| +newSVsv||| +newSVuv|5.006000||p +newSV||| +newUNOP||| +newWHILEOP||5.004040| +newXSproto||5.006000| +newXS||5.006000| +new_collate||5.006000| +new_constant||| +new_ctype||5.006000| +new_he||| +new_logop||| +new_numeric||5.006000| +new_stackinfo||5.005000| +new_version||5.009000| +new_xiv||| +new_xnv||| +new_xpvav||| +new_xpvbm||| +new_xpvcv||| +new_xpvhv||| +new_xpviv||| +new_xpvlv||| +new_xpvmg||| +new_xpvnv||| +new_xpv||| +new_xrv||| +next_symbol||| +nextargv||| +nextchar||| +ninstr||| +no_bareword_allowed||| +no_fh_allowed||| +no_op||| +not_a_number||| +nothreadhook||5.008000| +nuke_stacks||| +num_overflow|||n +oopsAV||| +oopsCV||| +oopsHV||| +op_clear||| +op_const_sv||| +op_dump||5.006000| +op_free||| +op_null||5.007002| +open_script||| +pMY_CXT_|5.007003||p +pMY_CXT|5.007003||p +pTHX_|5.006000||p +pTHX|5.006000||p +pack_cat||5.007003| +pack_rec||| +package||| +packlist||5.008001| +pad_add_anon||| +pad_add_name||| +pad_alloc||| +pad_block_start||| +pad_check_dup||| +pad_findlex||| +pad_findmy||| +pad_fixup_inner_anons||| +pad_free||| +pad_leavemy||| +pad_new||| +pad_push||| +pad_reset||| +pad_setsv||| +pad_sv||| +pad_swipe||| +pad_tidy||| +pad_undef||| +parse_body||| +parse_unicode_opts||| +path_is_absolute||| +peep||| +pending_ident||| +perl_alloc_using|||n +perl_alloc|||n +perl_clone_using|||n +perl_clone|||n +perl_construct|||n +perl_destruct||5.007003|n +perl_free|||n +perl_parse||5.006000|n +perl_run|||n +pidgone||| +pmflag||| +pmop_dump||5.006000| +pmruntime||| +pmtrans||| +pop_scope||| +pregcomp||| +pregexec||| +pregfree||| +prepend_elem||| +printf_nocontext|||vn +ptr_table_clear||| +ptr_table_fetch||| +ptr_table_free||| +ptr_table_new||| +ptr_table_split||| +ptr_table_store||| +push_scope||| +put_byte||| +pv_display||5.006000| +pv_uni_display||5.007003| +qerror||| +re_croak2||| +re_dup||| +re_intuit_start||5.006000| +re_intuit_string||5.006000| +realloc||5.007002|n +reentrant_free||| +reentrant_init||| +reentrant_retry|||vn +reentrant_size||| +refkids||| +refto||| +ref||| +reg_node||| +reganode||| +regatom||| +regbranch||| +regclass_swash||5.007003| +regclass||| +regcp_set_to||| +regcppop||| +regcppush||| +regcurly||| +regdump||5.005000| +regexec_flags||5.005000| +reghop3||| +reghopmaybe3||| +reghopmaybe||| +reghop||| +reginclass||| +reginitcolors||5.006000| +reginsert||| +regmatch||| +regnext||5.005000| +regoptail||| +regpiece||| +regpposixcc||| +regprop||| +regrepeat_hard||| +regrepeat||| +regtail||| +regtry||| +reguni||| +regwhite||| +reg||| +repeatcpy||| +report_evil_fh||| +report_uninit||| +require_errno||| +require_pv||5.006000| +rninstr||| +rsignal_restore||| +rsignal_save||| +rsignal_state||5.004000| +rsignal||5.004000| +run_body||| +runops_debug||5.005000| +runops_standard||5.005000| +rxres_free||| +rxres_restore||| +rxres_save||| +safesyscalloc||5.006000|n +safesysfree||5.006000|n +safesysmalloc||5.006000|n +safesysrealloc||5.006000|n +same_dirent||| +save_I16||5.004000| +save_I32||| +save_I8||5.006000| +save_aelem||5.004050| +save_alloc||5.006000| +save_aptr||| +save_ary||| +save_bool||5.008001| +save_clearsv||| +save_delete||| +save_destructor_x||5.006000| +save_destructor||5.006000| +save_freeop||| +save_freepv||| +save_freesv||| +save_generic_pvref||5.006001| +save_generic_svref||5.005030| +save_gp||5.004000| +save_hash||| +save_hek_flags||| +save_helem||5.004050| +save_hints||5.005000| +save_hptr||| +save_int||| +save_item||| +save_iv||5.005000| +save_lines||| +save_list||| +save_long||| +save_magic||| +save_mortalizesv||5.007001| +save_nogv||| +save_op||| +save_padsv||5.007001| +save_pptr||| +save_re_context||5.006000| +save_scalar_at||| +save_scalar||| +save_set_svflags||5.009000| +save_shared_pvref||5.007003| +save_sptr||| +save_svref||| +save_threadsv||5.005000| +save_vptr||5.006000| +savepvn||| +savepv||| +savesharedpv||5.007003| +savestack_grow_cnt||5.008001| +savestack_grow||| +sawparens||| +scalar_mod_type||| +scalarboolean||| +scalarkids||| +scalarseq||| +scalarvoid||| +scalar||| +scan_bin||5.006000| +scan_commit||| +scan_const||| +scan_formline||| +scan_heredoc||| +scan_hex||| +scan_ident||| +scan_inputsymbol||| +scan_num||5.007001| +scan_oct||| +scan_pat||| +scan_str||| +scan_subst||| +scan_trans||| +scan_version||5.009001| +scan_vstring||5.008001| +scan_word||| +scope||| +screaminstr||5.005000| +seed||| +set_context||5.006000|n +set_csh||| +set_numeric_local||5.006000| +set_numeric_radix||5.006000| +set_numeric_standard||5.006000| +setdefout||| +setenv_getix||| +share_hek_flags||| +share_hek||| +si_dup||| +sighandler|||n +simplify_sort||| +skipspace||| +sortsv||5.007003| +ss_dup||| +stack_grow||| +start_glob||| +start_subparse||5.004000| +stdize_locale||| +strEQ||| +strGE||| +strGT||| +strLE||| +strLT||| +strNE||| +str_to_version||5.006000| +strnEQ||| +strnNE||| +study_chunk||| +sub_crush_depth||| +sublex_done||| +sublex_push||| +sublex_start||| +sv_2bool||| +sv_2cv||| +sv_2io||| +sv_2iuv_non_preserve||| +sv_2iv_flags||5.009001| +sv_2iv||| +sv_2mortal||| +sv_2nv||| +sv_2pv_flags||5.007002| +sv_2pv_nolen|5.006000||p +sv_2pvbyte_nolen||| +sv_2pvbyte|5.006000||p +sv_2pvutf8_nolen||5.006000| +sv_2pvutf8||5.006000| +sv_2pv||| +sv_2uv_flags||5.009001| +sv_2uv|5.004000||p +sv_add_arena||| +sv_add_backref||| +sv_backoff||| +sv_bless||| +sv_cat_decode||5.008001| +sv_catpv_mg|5.006000||p +sv_catpvf_mg_nocontext|||pvn +sv_catpvf_mg|5.006000|5.004000|pv +sv_catpvf_nocontext|||vn +sv_catpvf||5.004000|v +sv_catpvn_flags||5.007002| +sv_catpvn_mg|5.006000||p +sv_catpvn_nomg|5.007002||p +sv_catpvn||| +sv_catpv||| +sv_catsv_flags||5.007002| +sv_catsv_mg|5.006000||p +sv_catsv_nomg|5.007002||p +sv_catsv||| +sv_chop||| +sv_clean_all||| +sv_clean_objs||| +sv_clear||| +sv_cmp_locale||5.004000| +sv_cmp||| +sv_collxfrm||| +sv_compile_2op||5.008001| +sv_copypv||5.007003| +sv_dec||| +sv_del_backref||| +sv_derived_from||5.004000| +sv_dump||| +sv_dup||| +sv_eq||| +sv_force_normal_flags||5.007001| +sv_force_normal||5.006000| +sv_free2||| +sv_free_arenas||| +sv_free||| +sv_gets||5.004000| +sv_grow||| +sv_inc||| +sv_insert||| +sv_isa||| +sv_isobject||| +sv_iv||5.005000| +sv_len_utf8||5.006000| +sv_len||| +sv_magicext||5.007003| +sv_magic||| +sv_mortalcopy||| +sv_newmortal||| +sv_newref||| +sv_nolocking||5.007003| +sv_nosharing||5.007003| +sv_nounlocking||5.007003| +sv_nv||5.005000| +sv_peek||5.005000| +sv_pos_b2u||5.006000| +sv_pos_u2b||5.006000| +sv_pvbyten_force||5.006000| +sv_pvbyten||5.006000| +sv_pvbyte||5.006000| +sv_pvn_force_flags||5.007002| +sv_pvn_force|||p +sv_pvn_nomg|5.007003||p +sv_pvn|5.006000||p +sv_pvutf8n_force||5.006000| +sv_pvutf8n||5.006000| +sv_pvutf8||5.006000| +sv_pv||5.006000| +sv_recode_to_utf8||5.007003| +sv_reftype||| +sv_release_COW||| +sv_release_IVX||| +sv_replace||| +sv_report_used||| +sv_reset||| +sv_rvweaken||5.006000| +sv_setiv_mg|5.006000||p +sv_setiv||| +sv_setnv_mg|5.006000||p +sv_setnv||| +sv_setpv_mg|5.006000||p +sv_setpvf_mg_nocontext|||pvn +sv_setpvf_mg|5.006000|5.004000|pv +sv_setpvf_nocontext|||vn +sv_setpvf||5.004000|v +sv_setpviv_mg||5.008001| +sv_setpviv||5.008001| +sv_setpvn_mg|5.006000||p +sv_setpvn||| +sv_setpv||| +sv_setref_iv||| +sv_setref_nv||| +sv_setref_pvn||| +sv_setref_pv||| +sv_setref_uv||5.007001| +sv_setsv_cow||| +sv_setsv_flags||5.007002| +sv_setsv_mg|5.006000||p +sv_setsv_nomg|5.007002||p +sv_setsv||| +sv_setuv_mg|5.006000||p +sv_setuv|5.006000||p +sv_tainted||5.004000| +sv_taint||5.004000| +sv_true||5.005000| +sv_unglob||| +sv_uni_display||5.007003| +sv_unmagic||| +sv_unref_flags||5.007001| +sv_unref||| +sv_untaint||5.004000| +sv_upgrade||| +sv_usepvn_mg|5.006000||p +sv_usepvn||| +sv_utf8_decode||5.006000| +sv_utf8_downgrade||5.006000| +sv_utf8_encode||5.006000| +sv_utf8_upgrade_flags||5.007002| +sv_utf8_upgrade||5.007001| +sv_uv|5.006000||p +sv_vcatpvf_mg|5.006000|5.004000|p +sv_vcatpvfn||5.004000| +sv_vcatpvf|5.006000|5.004000|p +sv_vsetpvf_mg|5.006000|5.004000|p +sv_vsetpvfn||5.004000| +sv_vsetpvf|5.006000|5.004000|p +svtype||| +swallow_bom||| +swash_fetch||5.007002| +swash_init||5.006000| +sys_intern_clear||| +sys_intern_dup||| +sys_intern_init||| +taint_env||| +taint_proper||| +tmps_grow||5.006000| +toLOWER||| +toUPPER||| +to_byte_substr||| +to_uni_fold||5.007003| +to_uni_lower_lc||5.006000| +to_uni_lower||5.007003| +to_uni_title_lc||5.006000| +to_uni_title||5.007003| +to_uni_upper_lc||5.006000| +to_uni_upper||5.007003| +to_utf8_case||5.007003| +to_utf8_fold||5.007003| +to_utf8_lower||5.007003| +to_utf8_substr||| +to_utf8_title||5.007003| +to_utf8_upper||5.007003| +tokeq||| +tokereport||| +too_few_arguments||| +too_many_arguments||| +unlnk||| +unpack_rec||| +unpack_str||5.007003| +unpackstring||5.008001| +unshare_hek_or_pvn||| +unshare_hek||| +unsharepvn||5.004000| +upg_version||5.009000| +usage||| +utf16_textfilter||| +utf16_to_utf8_reversed||5.006001| +utf16_to_utf8||5.006001| +utf16rev_textfilter||| +utf8_distance||5.006000| +utf8_hop||5.006000| +utf8_length||5.007001| +utf8_mg_pos_init||| +utf8_mg_pos||| +utf8_to_bytes||5.006001| +utf8_to_uvchr||5.007001| +utf8_to_uvuni||5.007001| +utf8n_to_uvchr||5.007001| +utf8n_to_uvuni||5.007001| +utilize||| +uvchr_to_utf8_flags||5.007003| +uvchr_to_utf8||5.007001| +uvuni_to_utf8_flags||5.007003| +uvuni_to_utf8||5.007001| +validate_suid||| +vcall_body||| +vcall_list_body||| +vcmp||5.009000| +vcroak||5.006000| +vdeb||5.007003| +vdefault_protect||| +vdie||| +vdocatch_body||| +vform||5.006000| +visit||| +vivify_defelem||| +vivify_ref||| +vload_module||5.006000| +vmess||5.006000| +vnewSVpvf|5.006000|5.004000|p +vnormal||5.009002| +vnumify||5.009000| +vparse_body||| +vrun_body||| +vstringify||5.009000| +vwarner||5.006000| +vwarn||5.006000| +wait4pid||| +warn_nocontext|||vn +warner_nocontext|||vn +warner||5.006000|v +warn|||v +watch||| +whichsig||| +write_to_stderr||| +yyerror||| +yylex||| +yyparse||| +yywarn||| +); + +if (exists $opt{'list-unsupported'}) { + my $f; + for $f (sort { lc $a cmp lc $b } keys %API) { + next unless $API{$f}{todo}; + print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n"; + } + exit 0; +} + +# Scan for possible replacement candidates + +my(%replace, %need, %hints, %depends); +my $replace = 0; +my $hint = ''; + +while (<DATA>) { + if ($hint) { + if (m{^\s*\*\s(.*?)\s*$}) { + $hints{$hint} ||= ''; # suppress warning with older perls + $hints{$hint} .= "$1\n"; + } + else { + $hint = ''; + } + } + $hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$}; + + $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$}; + $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)}; + $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce}; + $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$}; + + if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) { + push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2; + } + + $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)}; +} + +if (exists $opt{'list-provided'}) { + my $f; + for $f (sort { lc $a cmp lc $b } keys %API) { + next unless $API{$f}{provided}; + my @flags; + push @flags, 'explicit' if exists $need{$f}; + push @flags, 'depend' if exists $depends{$f}; + push @flags, 'hint' if exists $hints{$f}; + my $flags = @flags ? ' ['.join(', ', @flags).']' : ''; + print "$f$flags\n"; + } + exit 0; +} + +my(%files, %global, %revreplace); +%revreplace = reverse %replace; +my $filename; +my $patch_opened = 0; + +for $filename (@files) { + unless (open IN, "<$filename") { + warn "Unable to read from $filename: $!\n"; + next; + } + + info("Scanning $filename ..."); + + my $c = do { local $/; <IN> }; + close IN; + + my %file = (orig => $c, changes => 0); + + # temporarily remove C comments from the code + my @ccom; + $c =~ s{ + ( + [^"'/]+ + | + (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+ + | + (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+ + ) + | + (/ (?: + \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / + | + /[^\r\n]* + )) + }{ + defined $2 and push @ccom, $2; + defined $1 ? $1 : "$ccs$#ccom$cce"; + }egsx; + + $file{ccom} = \@ccom; + $file{code} = $c; + $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/); + + my $func; + + for $func (keys %API) { + my $match = $func; + $match .= "|$revreplace{$func}" if exists $revreplace{$func}; + if ($c =~ /\b(?:Perl_)?($match)\b/) { + $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func}; + $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/; + if (exists $API{$func}{provided}) { + if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) { + $file{uses}{$func}++; + my @deps = rec_depend($func); + if (@deps) { + $file{uses_deps}{$func} = \@deps; + for (@deps) { + $file{uses}{$_} = 0 unless exists $file{uses}{$_}; + } + } + for ($func, @deps) { + if (exists $need{$_}) { + $file{needs}{$_} = 'static'; + } + } + } + } + if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) { + if ($c =~ /\b$func\b/) { + $file{uses_todo}{$func}++; + } + } + } + } + + while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) { + if (exists $need{$2}) { + $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++; + } + else { + warning("Possibly wrong #define $1 in $filename"); + } + } + + for (qw(uses needs uses_todo needed_global needed_static)) { + for $func (keys %{$file{$_}}) { + push @{$global{$_}{$func}}, $filename; + } + } + + $files{$filename} = \%file; } + +# Globally resolve NEED_'s +my $need; +for $need (keys %{$global{needs}}) { + if (@{$global{needs}{$need}} > 1) { + my @targets = @{$global{needs}{$need}}; + my @t = grep $files{$_}{needed_global}{$need}, @targets; + @targets = @t if @t; + @t = grep /\.xs$/i, @targets; + @targets = @t if @t; + my $target = shift @targets; + $files{$target}{needs}{$need} = 'global'; + for (@{$global{needs}{$need}}) { + $files{$_}{needs}{$need} = 'extern' if $_ ne $target; + } + } +} + +for $filename (@files) { + exists $files{$filename} or next; + + info("=== Analyzing $filename ==="); + + my %file = %{$files{$filename}}; + my $func; + my $c = $file{code}; + + for $func (sort keys %{$file{uses_Perl}}) { + if ($API{$func}{varargs}) { + my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))} + { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge); + if ($changes) { + warning("Doesn't pass interpreter argument aTHX to Perl_$func"); + $file{changes} += $changes; + } + } + else { + warning("Uses Perl_$func instead of $func"); + $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*} + {$func$1(}g); + } + } + + for $func (sort keys %{$file{uses_replace}}) { + warning("Uses $func instead of $replace{$func}"); + $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); + } + + for $func (sort keys %{$file{uses}}) { + next unless $file{uses}{$func}; # if it's only a dependency + if (exists $file{uses_deps}{$func}) { + diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}})); + } + elsif (exists $replace{$func}) { + warning("Uses $func instead of $replace{$func}"); + $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); + } + else { + diag("Uses $func"); + } + hint($func); + } + + for $func (sort keys %{$file{uses_todo}}) { + warning("Uses $func, which may not be portable below perl ", + format_version($API{$func}{todo})); + } + + for $func (sort keys %{$file{needed_static}}) { + my $message = ''; + if (not exists $file{uses}{$func}) { + $message = "No need to define NEED_$func if $func is never used"; + } + elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') { + $message = "No need to define NEED_$func when already needed globally"; + } + if ($message) { + diag($message); + $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg); + } + } + + for $func (sort keys %{$file{needed_global}}) { + my $message = ''; + if (not exists $global{uses}{$func}) { + $message = "No need to define NEED_${func}_GLOBAL if $func is never used"; + } + elsif (exists $file{needs}{$func}) { + if ($file{needs}{$func} eq 'extern') { + $message = "No need to define NEED_${func}_GLOBAL when already needed globally"; + } + elsif ($file{needs}{$func} eq 'static') { + $message = "No need to define NEED_${func}_GLOBAL when only used in this file"; + } + } + if ($message) { + diag($message); + $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg); + } + } + + $file{needs_inc_ppport} = keys %{$file{uses}}; + + if ($file{needs_inc_ppport}) { + my $pp = ''; + + for $func (sort keys %{$file{needs}}) { + my $type = $file{needs}{$func}; + next if $type eq 'extern'; + my $suffix = $type eq 'global' ? '_GLOBAL' : ''; + unless (exists $file{"needed_$type"}{$func}) { + if ($type eq 'global') { + diag("Files [@{$global{needs}{$func}}] need $func, adding global request"); + } + else { + diag("File needs $func, adding static request"); + } + $pp .= "#define NEED_$func$suffix\n"; + } + } + + if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) { + $pp = ''; + $file{changes}++; + } + + unless ($file{has_inc_ppport}) { + diag("Needs to include '$ppport'"); + $pp .= qq(#include "$ppport"\n) + } + + if ($pp) { + $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms) + || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m) + || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m) + || ($c =~ s/^/$pp/); + } + } + else { + if ($file{has_inc_ppport}) { + diag("No need to include '$ppport'"); + $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m); + } + } + + # put back in our C comments + my $ix; + my $cppc = 0; + my @ccom = @{$file{ccom}}; + for $ix (0 .. $#ccom) { + if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) { + $cppc++; + $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/; + } + else { + $c =~ s/$rccs$ix$rcce/$ccom[$ix]/; + } + } + + if ($cppc) { + my $s = $cppc != 1 ? 's' : ''; + warning("Uses $cppc C++ style comment$s, which is not portable"); + } + + if ($file{changes}) { + if (exists $opt{copy}) { + my $newfile = "$filename$opt{copy}"; + if (-e $newfile) { + error("'$newfile' already exists, refusing to write copy of '$filename'"); + } + else { + local *F; + if (open F, ">$newfile") { + info("Writing copy of '$filename' with changes to '$newfile'"); + print F $c; + close F; + } + else { + error("Cannot open '$newfile' for writing: $!"); + } + } + } + elsif (exists $opt{patch} || $opt{changes}) { + if (exists $opt{patch}) { + unless ($patch_opened) { + if (open PATCH, ">$opt{patch}") { + $patch_opened = 1; + } + else { + error("Cannot open '$opt{patch}' for writing: $!"); + delete $opt{patch}; + $opt{changes} = 1; + goto fallback; + } + } + mydiff(\*PATCH, $filename, $c); + } + else { +fallback: + info("Suggested changes:"); + mydiff(\*STDOUT, $filename, $c); + } + } + else { + my $s = $file{changes} == 1 ? '' : 's'; + info("$file{changes} potentially required change$s detected"); + } + } + else { + info("Looks good"); + } +} + +close PATCH if $patch_opened; + +exit 0; + + +sub mydiff +{ + local *F = shift; + my($file, $str) = @_; + my $diff; + + if (exists $opt{diff}) { + $diff = run_diff($opt{diff}, $file, $str); + } + + if (!defined $diff and can_use('Text::Diff')) { + $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' }); + $diff = <<HEADER . $diff; +--- $file ++++ $file.patched +HEADER + } + + if (!defined $diff) { + $diff = run_diff('diff -u', $file, $str); + } + + if (!defined $diff) { + $diff = run_diff('diff', $file, $str); + } + + if (!defined $diff) { + error("Cannot generate a diff. Please install Text::Diff or use --copy."); + return; + } + + print F $diff; + +} + +sub run_diff +{ + my($prog, $file, $str) = @_; + my $tmp = 'dppptemp'; + my $suf = 'aaa'; + my $diff = ''; + local *F; + + while (-e "$tmp.$suf") { $suf++ } + $tmp = "$tmp.$suf"; + + if (open F, ">$tmp") { + print F $str; + close F; + + if (open F, "$prog $file $tmp |") { + while (<F>) { + s/\Q$tmp\E/$file.patched/; + $diff .= $_; + } + close F; + unlink $tmp; + return $diff; + } + + unlink $tmp; + } + else { + error("Cannot open '$tmp' for writing: $!"); + } + + return undef; +} + +sub can_use +{ + eval "use @_;"; + return $@ eq ''; +} + +sub rec_depend +{ + my $func = shift; + my %seen; + return () unless exists $depends{$func}; + grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}}; +} + +sub parse_version +{ + my $ver = shift; + + if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { + return ($1, $2, $3); + } + elsif ($ver !~ /^\d+\.[\d_]+$/) { + die "cannot parse version '$ver'\n"; + } + + $ver =~ s/_//g; + $ver =~ s/$/000000/; + + my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; + + $v = int $v; + $s = int $s; + + if ($r < 5 || ($r == 5 && $v < 6)) { + if ($s % 10) { + die "cannot parse version '$ver'\n"; + } + } + + return ($r, $v, $s); +} + +sub format_version +{ + my $ver = shift; + + $ver =~ s/$/000000/; + my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; + + $v = int $v; + $s = int $s; + + if ($r < 5 || ($r == 5 && $v < 6)) { + if ($s % 10) { + die "invalid version '$ver'\n"; + } + $s /= 10; + + $ver = sprintf "%d.%03d", $r, $v; + $s > 0 and $ver .= sprintf "_%02d", $s; + + return $ver; + } + + return sprintf "%d.%d.%d", $r, $v, $s; +} + +sub info +{ + $opt{quiet} and return; + print @_, "\n"; +} + +sub diag +{ + $opt{quiet} and return; + $opt{diag} and print @_, "\n"; +} + +sub warning +{ + $opt{quiet} and return; + print "*** ", @_, "\n"; +} + +sub error +{ + print "*** ERROR: ", @_, "\n"; +} + +my %given_hints; +sub hint +{ + $opt{quiet} and return; + $opt{hints} or return; + my $func = shift; + exists $hints{$func} or return; + $given_hints{$func}++ and return; + my $hint = $hints{$func}; + $hint =~ s/^/ /mg; + print " --- hint for $func ---\n", $hint; +} + +sub usage +{ + my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms; + my %M = ( 'I' => '*' ); + $usage =~ s/^\s*perl\s+\S+/$^X $0/; + $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g; + + print <<ENDUSAGE; + +Usage: $usage + +See perldoc $0 for details. + +ENDUSAGE + + exit 2; +} + __DATA__ */ #ifndef _P_P_PORTABILITY_H_ #define _P_P_PORTABILITY_H_ +#ifndef DPPP_NAMESPACE +# define DPPP_NAMESPACE DPPP_ +#endif + +#define DPPP_CAT2(x,y) CAT2(x,y) +#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name) + #ifndef PERL_REVISION -# ifndef __PATCHLEVEL_H_INCLUDED__ -# define PERL_PATCHLEVEL_H_IMPLICIT -# include <patchlevel.h> -# endif -# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) -# include <could_not_find_Perl_patchlevel.h> -# endif -# ifndef PERL_REVISION -# define PERL_REVISION (5) - /* Replace: 1 */ -# define PERL_VERSION PATCHLEVEL -# define PERL_SUBVERSION SUBVERSION - /* Replace PERL_PATCHLEVEL with PERL_VERSION */ - /* Replace: 0 */ -# endif +# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION)) +# define PERL_PATCHLEVEL_H_IMPLICIT +# include <patchlevel.h> +# endif +# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) +# include <could_not_find_Perl_patchlevel.h> +# endif +# ifndef PERL_REVISION +# define PERL_REVISION (5) + /* Replace: 1 */ +# define PERL_VERSION PATCHLEVEL +# define PERL_SUBVERSION SUBVERSION + /* Replace PERL_PATCHLEVEL with PERL_VERSION */ + /* Replace: 0 */ +# endif #endif #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) @@ -390,32 +3445,435 @@ __DATA__ (or greater), but who knows. */ #if PERL_REVISION != 5 -# error ppport.h only works with Perl version 5 +# error ppport.h only works with Perl version 5 #endif /* PERL_REVISION != 5 */ -#ifndef ERRSV -# define ERRSV perl_get_sv("@",FALSE) +#ifdef I_LIMITS +# include <limits.h> +#endif + +#ifndef PERL_UCHAR_MIN +# define PERL_UCHAR_MIN ((unsigned char)0) +#endif + +#ifndef PERL_UCHAR_MAX +# ifdef UCHAR_MAX +# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) +# else +# ifdef MAXUCHAR +# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR) +# else +# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0) +# endif +# endif +#endif + +#ifndef PERL_USHORT_MIN +# define PERL_USHORT_MIN ((unsigned short)0) +#endif + +#ifndef PERL_USHORT_MAX +# ifdef USHORT_MAX +# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) +# else +# ifdef MAXUSHORT +# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) +# else +# ifdef USHRT_MAX +# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) +# else +# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) +# endif +# endif +# endif +#endif + +#ifndef PERL_SHORT_MAX +# ifdef SHORT_MAX +# define PERL_SHORT_MAX ((short)SHORT_MAX) +# else +# ifdef MAXSHORT /* Often used in <values.h> */ +# define PERL_SHORT_MAX ((short)MAXSHORT) +# else +# ifdef SHRT_MAX +# define PERL_SHORT_MAX ((short)SHRT_MAX) +# else +# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) +# endif +# endif +# endif +#endif + +#ifndef PERL_SHORT_MIN +# ifdef SHORT_MIN +# define PERL_SHORT_MIN ((short)SHORT_MIN) +# else +# ifdef MINSHORT +# define PERL_SHORT_MIN ((short)MINSHORT) +# else +# ifdef SHRT_MIN +# define PERL_SHORT_MIN ((short)SHRT_MIN) +# else +# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) +# endif +# endif +# endif +#endif + +#ifndef PERL_UINT_MAX +# ifdef UINT_MAX +# define PERL_UINT_MAX ((unsigned int)UINT_MAX) +# else +# ifdef MAXUINT +# define PERL_UINT_MAX ((unsigned int)MAXUINT) +# else +# define PERL_UINT_MAX (~(unsigned int)0) +# endif +# endif +#endif + +#ifndef PERL_UINT_MIN +# define PERL_UINT_MIN ((unsigned int)0) +#endif + +#ifndef PERL_INT_MAX +# ifdef INT_MAX +# define PERL_INT_MAX ((int)INT_MAX) +# else +# ifdef MAXINT /* Often used in <values.h> */ +# define PERL_INT_MAX ((int)MAXINT) +# else +# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1)) +# endif +# endif +#endif + +#ifndef PERL_INT_MIN +# ifdef INT_MIN +# define PERL_INT_MIN ((int)INT_MIN) +# else +# ifdef MININT +# define PERL_INT_MIN ((int)MININT) +# else +# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) +# endif +# endif +#endif + +#ifndef PERL_ULONG_MAX +# ifdef ULONG_MAX +# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) +# else +# ifdef MAXULONG +# define PERL_ULONG_MAX ((unsigned long)MAXULONG) +# else +# define PERL_ULONG_MAX (~(unsigned long)0) +# endif +# endif +#endif + +#ifndef PERL_ULONG_MIN +# define PERL_ULONG_MIN ((unsigned long)0L) +#endif + +#ifndef PERL_LONG_MAX +# ifdef LONG_MAX +# define PERL_LONG_MAX ((long)LONG_MAX) +# else +# ifdef MAXLONG +# define PERL_LONG_MAX ((long)MAXLONG) +# else +# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1)) +# endif +# endif +#endif + +#ifndef PERL_LONG_MIN +# ifdef LONG_MIN +# define PERL_LONG_MIN ((long)LONG_MIN) +# else +# ifdef MINLONG +# define PERL_LONG_MIN ((long)MINLONG) +# else +# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) +# endif +# endif +#endif + +#if defined(HAS_QUAD) && (defined(convex) || defined(uts)) +# ifndef PERL_UQUAD_MAX +# ifdef ULONGLONG_MAX +# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX) +# else +# ifdef MAXULONGLONG +# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG) +# else +# define PERL_UQUAD_MAX (~(unsigned long long)0) +# endif +# endif +# endif + +# ifndef PERL_UQUAD_MIN +# define PERL_UQUAD_MIN ((unsigned long long)0L) +# endif + +# ifndef PERL_QUAD_MAX +# ifdef LONGLONG_MAX +# define PERL_QUAD_MAX ((long long)LONGLONG_MAX) +# else +# ifdef MAXLONGLONG +# define PERL_QUAD_MAX ((long long)MAXLONGLONG) +# else +# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1)) +# endif +# endif +# endif + +# ifndef PERL_QUAD_MIN +# ifdef LONGLONG_MIN +# define PERL_QUAD_MIN ((long long)LONGLONG_MIN) +# else +# ifdef MINLONGLONG +# define PERL_QUAD_MIN ((long long)MINLONGLONG) +# else +# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) +# endif +# endif +# endif +#endif + +/* This is based on code from 5.003 perl.h */ +#ifdef HAS_QUAD +# ifdef cray +#ifndef IVTYPE +# define IVTYPE int +#endif + +#ifndef IV_MIN +# define IV_MIN PERL_INT_MIN +#endif + +#ifndef IV_MAX +# define IV_MAX PERL_INT_MAX +#endif + +#ifndef UV_MIN +# define UV_MIN PERL_UINT_MIN +#endif + +#ifndef UV_MAX +# define UV_MAX PERL_UINT_MAX +#endif + +# ifdef INTSIZE +#ifndef IVSIZE +# define IVSIZE INTSIZE +#endif + +# endif +# else +# if defined(convex) || defined(uts) +#ifndef IVTYPE +# define IVTYPE long long +#endif + +#ifndef IV_MIN +# define IV_MIN PERL_QUAD_MIN +#endif + +#ifndef IV_MAX +# define IV_MAX PERL_QUAD_MAX +#endif + +#ifndef UV_MIN +# define UV_MIN PERL_UQUAD_MIN +#endif + +#ifndef UV_MAX +# define UV_MAX PERL_UQUAD_MAX +#endif + +# ifdef LONGLONGSIZE +#ifndef IVSIZE +# define IVSIZE LONGLONGSIZE +#endif + +# endif +# else +#ifndef IVTYPE +# define IVTYPE long +#endif + +#ifndef IV_MIN +# define IV_MIN PERL_LONG_MIN +#endif + +#ifndef IV_MAX +# define IV_MAX PERL_LONG_MAX +#endif + +#ifndef UV_MIN +# define UV_MIN PERL_ULONG_MIN +#endif + +#ifndef UV_MAX +# define UV_MAX PERL_ULONG_MAX +#endif + +# ifdef LONGSIZE +#ifndef IVSIZE +# define IVSIZE LONGSIZE +#endif + +# endif +# endif +# endif +#ifndef IVSIZE +# define IVSIZE 8 +#endif + +#ifndef PERL_QUAD_MIN +# define PERL_QUAD_MIN IV_MIN +#endif + +#ifndef PERL_QUAD_MAX +# define PERL_QUAD_MAX IV_MAX +#endif + +#ifndef PERL_UQUAD_MIN +# define PERL_UQUAD_MIN UV_MIN +#endif + +#ifndef PERL_UQUAD_MAX +# define PERL_UQUAD_MAX UV_MAX +#endif + +#else +#ifndef IVTYPE +# define IVTYPE long +#endif + +#ifndef IV_MIN +# define IV_MIN PERL_LONG_MIN +#endif + +#ifndef IV_MAX +# define IV_MAX PERL_LONG_MAX +#endif + +#ifndef UV_MIN +# define UV_MIN PERL_ULONG_MIN +#endif + +#ifndef UV_MAX +# define UV_MAX PERL_ULONG_MAX +#endif + +#endif + +#ifndef IVSIZE +# ifdef LONGSIZE +# define IVSIZE LONGSIZE +# else +# define IVSIZE 4 /* A bold guess, but the best we can make. */ +# endif +#endif +#ifndef UVTYPE +# define UVTYPE unsigned IVTYPE +#endif + +#ifndef UVSIZE +# define UVSIZE IVSIZE +#endif + +#ifndef sv_setuv +# define sv_setuv(sv, uv) \ + STMT_START { \ + UV TeMpUv = uv; \ + if (TeMpUv <= IV_MAX) \ + sv_setiv(sv, TeMpUv); \ + else \ + sv_setnv(sv, (double)TeMpUv); \ + } STMT_END +#endif + +#ifndef newSVuv +# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) +#endif +#ifndef sv_2uv +# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) +#endif + +#ifndef SvUVX +# define SvUVX(sv) ((UV)SvIVX(sv)) +#endif + +#ifndef SvUVXx +# define SvUVXx(sv) SvUVX(sv) +#endif + +#ifndef SvUV +# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) +#endif + +#ifndef SvUVx +# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) +#endif + +/* Hint: sv_uv + * Always use the SvUVx() macro instead of sv_uv(). + */ +#ifndef sv_uv +# define sv_uv(sv) SvUVx(sv) +#endif +#ifndef XST_mUV +# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) +#endif + +#ifndef XSRETURN_UV +# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END +#endif +#ifndef PUSHu +# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END +#endif + +#ifndef XPUSHu +# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END #endif #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) /* Replace: 1 */ -# define PL_Sv Sv -# define PL_compiling compiling -# define PL_copline copline -# define PL_curcop curcop -# define PL_curstash curstash -# define PL_defgv defgv -# define PL_dirty dirty -# define PL_dowarn dowarn -# define PL_hints hints -# define PL_na na -# define PL_perldb perldb -# define PL_rsfp_filters rsfp_filters -# define PL_rsfpv rsfp -# define PL_stdingv stdingv -# define PL_sv_no sv_no -# define PL_sv_undef sv_undef -# define PL_sv_yes sv_yes +# define PL_DBsingle DBsingle +# define PL_DBsub DBsub +# define PL_Sv Sv +# define PL_compiling compiling +# define PL_copline copline +# define PL_curcop curcop +# define PL_curstash curstash +# define PL_debstash debstash +# define PL_defgv defgv +# define PL_diehook diehook +# define PL_dirty dirty +# define PL_dowarn dowarn +# define PL_errgv errgv +# define PL_hexdigit hexdigit +# define PL_hints hints +# define PL_na na +# define PL_no_modify no_modify +# define PL_perl_destruct_level perl_destruct_level +# define PL_perldb perldb +# define PL_ppaddr ppaddr +# define PL_rsfp_filters rsfp_filters +# define PL_rsfp rsfp +# define PL_stack_base stack_base +# define PL_stack_sp stack_sp +# define PL_stdingv stdingv +# define PL_sv_arenaroot sv_arenaroot +# define PL_sv_no sv_no +# define PL_sv_undef sv_undef +# define PL_sv_yes sv_yes +# define PL_tainted tainted +# define PL_tainting tainting /* Replace: 0 */ #endif @@ -428,150 +3886,376 @@ __DATA__ #else # define PERL_UNUSED_DECL #endif +#ifndef NOOP +# define NOOP (void)0 +#endif #ifndef dNOOP -# define NOOP (void)0 -# define dNOOP extern int Perl___notused PERL_UNUSED_DECL +# define dNOOP extern int Perl___notused PERL_UNUSED_DECL #endif -#ifndef dTHR -# define dTHR dNOOP +#ifndef NVTYPE +# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) +# define NVTYPE long double +# else +# define NVTYPE double +# endif +typedef NVTYPE NV; #endif -#ifndef dTHX -# define dTHX dNOOP -# define dTHXa(x) dNOOP -# define dTHXoa(x) dNOOP +#ifndef INT2PTR + +# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) +# define PTRV UV +# define INT2PTR(any,d) (any)(d) +# else +# if PTRSIZE == LONGSIZE +# define PTRV unsigned long +# else +# define PTRV unsigned +# endif +# define INT2PTR(any,d) (any)(PTRV)(d) +# endif + +# define NUM2PTR(any,d) (any)(PTRV)(d) +# define PTR2IV(p) INT2PTR(IV,p) +# define PTR2UV(p) INT2PTR(UV,p) +# define PTR2NV(p) NUM2PTR(NV,p) + +# if PTRSIZE == LONGSIZE +# define PTR2ul(p) (unsigned long)(p) +# else +# define PTR2ul(p) INT2PTR(unsigned long,p) +# endif + +#endif /* !INT2PTR */ + +#undef START_EXTERN_C +#undef END_EXTERN_C +#undef EXTERN_C +#ifdef __cplusplus +# define START_EXTERN_C extern "C" { +# define END_EXTERN_C } +# define EXTERN_C extern "C" +#else +# define START_EXTERN_C +# define END_EXTERN_C +# define EXTERN_C extern #endif -#ifndef pTHX -# define pTHX void -# define pTHX_ -# define aTHX -# define aTHX_ -#endif +#ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN +# if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC) +# define PERL_GCC_BRACE_GROUPS_FORBIDDEN +# endif +#endif -#ifndef dAX -# define dAX I32 ax = MARK - PL_stack_base + 1 +#undef STMT_START +#undef STMT_END +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) +# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ +# define STMT_END ) +#else +# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) +# define STMT_START if (1) +# define STMT_END else (void)0 +# else +# define STMT_START do +# define STMT_END while (0) +# endif #endif -#ifndef dITEMS -# define dITEMS I32 items = SP - MARK +#ifndef boolSV +# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) #endif -/* IV could also be a quad (say, a long long), but Perls - * capable of those should have IVSIZE already. */ -#if !defined(IVSIZE) && defined(LONGSIZE) -# define IVSIZE LONGSIZE +/* DEFSV appears first in 5.004_56 */ +#ifndef DEFSV +# define DEFSV GvSV(PL_defgv) #endif -#ifndef IVSIZE -# define IVSIZE 4 /* A bold guess, but the best we can make. */ + +#ifndef SAVE_DEFSV +# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #endif -#ifndef UVSIZE -# define UVSIZE IVSIZE +/* Older perls (<=5.003) lack AvFILLp */ +#ifndef AvFILLp +# define AvFILLp AvFILL +#endif +#ifndef ERRSV +# define ERRSV get_sv("@",FALSE) +#endif +#ifndef newSVpvn +# define newSVpvn(data,len) ((data) \ + ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \ + : newSV(0)) #endif -#ifndef NVTYPE -# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) -# define NVTYPE long double -# else -# define NVTYPE double -# endif -typedef NVTYPE NV; +/* Hint: gv_stashpvn + * This function's backport doesn't support the length parameter, but + * rather ignores it. Portability can only be ensured if the length + * parameter is used for speed reasons, but the length can always be + * correctly computed from the string argument. + */ +#ifndef gv_stashpvn +# define gv_stashpvn(str,len,create) gv_stashpv(str,create) #endif -#ifndef INT2PTR +/* Replace: 1 */ +#ifndef get_cv +# define get_cv perl_get_cv +#endif + +#ifndef get_sv +# define get_sv perl_get_sv +#endif + +#ifndef get_av +# define get_av perl_get_av +#endif + +#ifndef get_hv +# define get_hv perl_get_hv +#endif + +/* Replace: 0 */ + +#ifdef HAS_MEMCMP +#ifndef memNE +# define memNE(s1,s2,l) (memcmp(s1,s2,l)) +#endif + +#ifndef memEQ +# define memEQ(s1,s2,l) (!memcmp(s1,s2,l)) +#endif -#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) -# define PTRV UV -# define INT2PTR(any,d) (any)(d) #else -# if PTRSIZE == LONGSIZE -# define PTRV unsigned long -# else -# define PTRV unsigned -# endif -# define INT2PTR(any,d) (any)(PTRV)(d) -#endif -#define NUM2PTR(any,d) (any)(PTRV)(d) -#define PTR2IV(p) INT2PTR(IV,p) -#define PTR2UV(p) INT2PTR(UV,p) -#define PTR2NV(p) NUM2PTR(NV,p) -#if PTRSIZE == LONGSIZE -# define PTR2ul(p) (unsigned long)(p) +#ifndef memNE +# define memNE(s1,s2,l) (bcmp(s1,s2,l)) +#endif + +#ifndef memEQ +# define memEQ(s1,s2,l) (!bcmp(s1,s2,l)) +#endif + +#endif +#ifndef MoveD +# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t)) +#endif + +#ifndef CopyD +# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) +#endif + +#ifdef HAS_MEMSET +#ifndef ZeroD +# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t)) +#endif + #else -# define PTR2ul(p) INT2PTR(unsigned long,p) +#ifndef ZeroD +# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)),d) #endif -#endif /* !INT2PTR */ +#endif +#ifndef Poison +# define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t)) +#endif +#ifndef dUNDERBAR +# define dUNDERBAR dNOOP +#endif -#ifndef boolSV -# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) +#ifndef UNDERBAR +# define UNDERBAR DEFSV +#endif +#ifndef dAX +# define dAX I32 ax = MARK - PL_stack_base + 1 #endif -#ifndef gv_stashpvn -# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) +#ifndef dITEMS +# define dITEMS I32 items = SP - MARK +#endif +#ifndef dTHR +# define dTHR dNOOP +#endif +#ifndef dTHX +# define dTHX dNOOP #endif -#ifndef newSVpvn -# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0)) +#ifndef dTHXa +# define dTHXa(x) dNOOP +#endif +#ifndef pTHX +# define pTHX void +#endif + +#ifndef pTHX_ +# define pTHX_ +#endif + +#ifndef aTHX +# define aTHX +#endif + +#ifndef aTHX_ +# define aTHX_ +#endif +#ifndef dTHXoa +# define dTHXoa(x) dTHXa(x) +#endif +#ifndef PUSHmortal +# define PUSHmortal PUSHs(sv_newmortal()) +#endif + +#ifndef mPUSHp +# define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l)) +#endif + +#ifndef mPUSHn +# define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n)) +#endif + +#ifndef mPUSHi +# define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i)) +#endif + +#ifndef mPUSHu +# define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u)) +#endif +#ifndef XPUSHmortal +# define XPUSHmortal XPUSHs(sv_newmortal()) +#endif + +#ifndef mXPUSHp +# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END +#endif + +#ifndef mXPUSHn +# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END +#endif + +#ifndef mXPUSHi +# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END +#endif + +#ifndef mXPUSHu +# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END #endif -#ifndef newRV_inc /* Replace: 1 */ -# define newRV_inc(sv) newRV(sv) +#ifndef call_sv +# define call_sv perl_call_sv +#endif + +#ifndef call_pv +# define call_pv perl_call_pv +#endif + +#ifndef call_argv +# define call_argv perl_call_argv +#endif + +#ifndef call_method +# define call_method perl_call_method +#endif +#ifndef eval_sv +# define eval_sv perl_eval_sv +#endif + /* Replace: 0 */ + +/* Replace perl_eval_pv with eval_pv */ +/* eval_pv depends on eval_sv */ + +#ifndef eval_pv +#if defined(NEED_eval_pv) +static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error); +static +#else +extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error); #endif -/* DEFSV appears first in 5.004_56 */ -#ifndef DEFSV -# define DEFSV GvSV(PL_defgv) +#ifdef eval_pv +# undef eval_pv #endif +#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b) +#define Perl_eval_pv DPPP_(my_eval_pv) -#ifndef SAVE_DEFSV -# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) +#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL) + +SV* +DPPP_(my_eval_pv)(char *p, I32 croak_on_error) +{ + dSP; + SV* sv = newSVpv(p, 0); + + PUSHMARK(sp); + eval_sv(sv, G_SCALAR); + SvREFCNT_dec(sv); + + SPAGAIN; + sv = POPs; + PUTBACK; + + if (croak_on_error && SvTRUE(GvSV(errgv))) + croak(SvPVx(GvSV(errgv), na)); + + return sv; +} + +#endif +#endif +#ifndef newRV_inc +# define newRV_inc(sv) newRV(sv) /* Replace */ #endif #ifndef newRV_noinc -# ifdef __GNUC__ -# define newRV_noinc(sv) \ - ({ \ - SV *nsv = (SV*)newRV(sv); \ - SvREFCNT_dec(sv); \ - nsv; \ - }) -# else -# if defined(USE_THREADS) -static SV * newRV_noinc (SV * sv) +#if defined(NEED_newRV_noinc) +static SV * DPPP_(my_newRV_noinc)(SV *sv); +static +#else +extern SV * DPPP_(my_newRV_noinc)(SV *sv); +#endif + +#ifdef newRV_noinc +# undef newRV_noinc +#endif +#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a) +#define Perl_newRV_noinc DPPP_(my_newRV_noinc) + +#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL) +SV * +DPPP_(my_newRV_noinc)(SV *sv) { - SV *nsv = (SV*)newRV(sv); - SvREFCNT_dec(sv); - return nsv; + SV *rv = (SV *)newRV(sv); + SvREFCNT_dec(sv); + return rv; } -# else -# define newRV_noinc(sv) \ - (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) -# endif -# endif +#endif #endif -/* Provide: newCONSTSUB */ +/* Hint: newCONSTSUB + * Returns a CV* as of perl-5.7.1. This return value is not supported + * by Devel::PPPort. + */ /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ -#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) - +#if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5)) #if defined(NEED_newCONSTSUB) +static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv); static #else -extern void newCONSTSUB(HV * stash, char * name, SV *sv); +extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv); #endif +#ifdef newCONSTSUB +# undef newCONSTSUB +#endif +#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c) +#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB) + #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) + void -newCONSTSUB(stash,name,sv) -HV *stash; -char *name; -SV *sv; +DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv) { U32 oldhints = PL_hints; HV *old_cop_stash = PL_curcop->cop_stash; @@ -585,17 +4269,12 @@ SV *sv; newSUB( -#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) - /* before 5.003_22 */ +#if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))) start_subparse(), -#else -# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) - /* 5.003_22 */ +#elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22)) start_subparse(0), -# else - /* 5.003_23 onwards */ +#else /* 5.003_23 onwards */ start_subparse(FALSE, 0), -# endif #endif newSVOP(OP_CONST, 0, newSVpv(name,0)), @@ -609,10 +4288,7 @@ SV *sv; PL_curcop->cop_line = oldline; } #endif - -#endif /* newCONSTSUB */ - -#ifndef START_MY_CXT +#endif /* * Boilerplate macros for initializing and accessing interpreter-local @@ -636,6 +4312,8 @@ SV *sv; #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) +#ifndef START_MY_CXT + /* This must appear in all extensions that define a my_cxt_t structure, * right after the definition (i.e. at file scope). The non-threads * case below uses it to declare the data as static. */ @@ -644,7 +4322,7 @@ SV *sv; #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 )) /* Fetches the SV that keeps the per-interpreter data. */ #define dMY_CXT_SV \ - SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE) + SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE) #else /* >= perl5.004_68 */ #define dMY_CXT_SV \ SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ @@ -680,8 +4358,21 @@ SV *sv; #define aMY_CXT_ aMY_CXT, #define _aMY_CXT ,aMY_CXT +#endif /* START_MY_CXT */ + +#ifndef MY_CXT_CLONE +/* Clones the per-interpreter data. */ +#define MY_CXT_CLONE \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ + Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) +#endif + #else /* single interpreter */ +#ifndef START_MY_CXT + #define START_MY_CXT static my_cxt_t my_cxt; #define dMY_CXT_SV dNOOP #define dMY_CXT dNOOP @@ -695,215 +4386,786 @@ SV *sv; #define aMY_CXT_ #define _aMY_CXT -#endif - #endif /* START_MY_CXT */ +#ifndef MY_CXT_CLONE +#define MY_CXT_CLONE NOOP +#endif + +#endif + #ifndef IVdf # if IVSIZE == LONGSIZE -# define IVdf "ld" -# define UVuf "lu" -# define UVof "lo" -# define UVxf "lx" -# define UVXf "lX" -# else -# if IVSIZE == INTSIZE -# define IVdf "d" -# define UVuf "u" -# define UVof "o" -# define UVxf "x" -# define UVXf "X" -# endif -# endif +# define IVdf "ld" +# define UVuf "lu" +# define UVof "lo" +# define UVxf "lx" +# define UVXf "lX" +# else +# if IVSIZE == INTSIZE +# define IVdf "d" +# define UVuf "u" +# define UVof "o" +# define UVxf "x" +# define UVXf "X" +# endif +# endif #endif #ifndef NVef -# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ - defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ -# define NVef PERL_PRIeldbl -# define NVff PERL_PRIfldbl -# define NVgf PERL_PRIgldbl -# else -# define NVef "e" -# define NVff "f" -# define NVgf "g" -# endif +# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ + defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ +# define NVef PERL_PRIeldbl +# define NVff PERL_PRIfldbl +# define NVgf PERL_PRIgldbl +# else +# define NVef "e" +# define NVff "f" +# define NVgf "g" +# endif +#endif + +#ifndef SvPV_nolen + +#if defined(NEED_sv_2pv_nolen) +static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv); +static +#else +extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv); +#endif + +#ifdef sv_2pv_nolen +# undef sv_2pv_nolen +#endif +#define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a) +#define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen) + +#if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL) + +char * +DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv) +{ + STRLEN n_a; + return sv_2pv(sv, &n_a); +} + #endif -#ifndef AvFILLp /* Older perls (<=5.003) lack AvFILLp */ -# define AvFILLp AvFILL +/* Hint: sv_2pv_nolen + * Use the SvPV_nolen() macro instead of sv_2pv_nolen(). + */ + +/* SvPV_nolen depends on sv_2pv_nolen */ +#define SvPV_nolen(sv) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? SvPVX(sv) : sv_2pv_nolen(sv)) + #endif #ifdef SvPVbyte -# if PERL_REVISION == 5 && PERL_VERSION < 7 - /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */ -# undef SvPVbyte -# define SvPVbyte(sv, lp) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ - ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp)) - static char * - my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) - { - sv_utf8_downgrade(sv,0); - return SvPV(sv,*lp); - } -# endif + +/* Hint: SvPVbyte + * Does not work in perl-5.6.1, ppport.h implements a version + * borrowed from perl-5.7.3. + */ + +#if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0))) + +#if defined(NEED_sv_2pvbyte) +static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp); +static #else -# define SvPVbyte SvPV +extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp); #endif -#ifndef SvPV_nolen -# define SvPV_nolen(sv) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ - ? SvPVX(sv) : sv_2pv_nolen(sv)) - static char * - sv_2pv_nolen(pTHX_ register SV *sv) - { - STRLEN n_a; - return sv_2pv(sv, &n_a); - } +#ifdef sv_2pvbyte +# undef sv_2pvbyte #endif +#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b) +#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte) -#ifndef get_cv -# define get_cv(name,create) perl_get_cv(name,create) -#endif +#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL) + +char * +DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp) +{ + sv_utf8_downgrade(sv,0); + return SvPV(sv,*lp); +} -#ifndef get_sv -# define get_sv(name,create) perl_get_sv(name,create) #endif -#ifndef get_av -# define get_av(name,create) perl_get_av(name,create) +/* Hint: sv_2pvbyte + * Use the SvPVbyte() macro instead of sv_2pvbyte(). + */ + +#undef SvPVbyte + +/* SvPVbyte depends on sv_2pvbyte */ +#define SvPVbyte(sv, lp) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) + #endif -#ifndef get_hv -# define get_hv(name,create) perl_get_hv(name,create) +#else + +# define SvPVbyte SvPV +# define sv_2pvbyte sv_2pv + #endif -#ifndef call_argv -# define call_argv perl_call_argv +/* sv_2pvbyte_nolen depends on sv_2pv_nolen */ +#ifndef sv_2pvbyte_nolen +# define sv_2pvbyte_nolen sv_2pv_nolen #endif -#ifndef call_method -# define call_method perl_call_method +/* Hint: sv_pvn + * Always use the SvPV() macro instead of sv_pvn(). + */ +#ifndef sv_pvn +# define sv_pvn(sv, len) SvPV(sv, len) #endif -#ifndef call_pv -# define call_pv perl_call_pv +/* Hint: sv_pvn + * Always use the SvPV_force() macro instead of sv_pvn_force(). + */ +#ifndef sv_pvn_force +# define sv_pvn_force(sv, len) SvPV_force(sv, len) #endif -#ifndef call_sv -# define call_sv perl_call_sv +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf) +#if defined(NEED_vnewSVpvf) +static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args); +static +#else +extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args); #endif -#ifndef eval_pv -# define eval_pv perl_eval_pv +#ifdef vnewSVpvf +# undef vnewSVpvf #endif +#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b) +#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf) + +#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL) + +SV * +DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args) +{ + register SV *sv = newSV(0); + sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); + return sv; +} -#ifndef eval_sv -# define eval_sv perl_eval_sv +#endif #endif -#ifndef PERL_SCAN_GREATER_THAN_UV_MAX -# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 +/* sv_vcatpvf depends on sv_vcatpvfn */ +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf) +# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) #endif -#ifndef PERL_SCAN_SILENT_ILLDIGIT -# define PERL_SCAN_SILENT_ILLDIGIT 0x04 +/* sv_vsetpvf depends on sv_vsetpvfn */ +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf) +# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) #endif -#ifndef PERL_SCAN_ALLOW_UNDERSCORES -# define PERL_SCAN_ALLOW_UNDERSCORES 0x01 +/* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */ +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg) +#if defined(NEED_sv_catpvf_mg) +static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...); +static +#else +extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...); #endif -#ifndef PERL_SCAN_DISALLOW_PREFIX -# define PERL_SCAN_DISALLOW_PREFIX 0x02 +#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg) + +#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL) + +void +DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...) +{ + va_list args; + va_start(args, pat); + sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + SvSETMAGIC(sv); + va_end(args); +} + +#endif #endif -#if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1)) -#define I32_CAST +/* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */ +#ifdef PERL_IMPLICIT_CONTEXT +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext) +#if defined(NEED_sv_catpvf_mg_nocontext) +static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...); +static #else -#define I32_CAST (I32*) +extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...); #endif -#ifndef grok_hex -static UV _grok_hex (char *string, STRLEN *len, I32 *flags, NV *result) { - NV r = scan_hex(string, *len, I32_CAST len); - if (r > UV_MAX) { - *flags |= PERL_SCAN_GREATER_THAN_UV_MAX; - if (result) *result = r; - return UV_MAX; - } - return (UV)r; +#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) +#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) + +#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL) + +void +DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...) +{ + dTHX; + va_list args; + va_start(args, pat); + sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + SvSETMAGIC(sv); + va_end(args); } - -# define grok_hex(string, len, flags, result) \ - _grok_hex((string), (len), (flags), (result)) -#endif -#ifndef grok_oct -static UV _grok_oct (char *string, STRLEN *len, I32 *flags, NV *result) { - NV r = scan_oct(string, *len, I32_CAST len); - if (r > UV_MAX) { - *flags |= PERL_SCAN_GREATER_THAN_UV_MAX; - if (result) *result = r; - return UV_MAX; - } - return (UV)r; +#endif +#endif +#endif + +#ifndef sv_catpvf_mg +# ifdef PERL_IMPLICIT_CONTEXT +# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext +# else +# define sv_catpvf_mg Perl_sv_catpvf_mg +# endif +#endif + +/* sv_vcatpvf_mg depends on sv_vcatpvfn */ +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg) +# define sv_vcatpvf_mg(sv, pat, args) \ + STMT_START { \ + sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ + SvSETMAGIC(sv); \ + } STMT_END +#endif + +/* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */ +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg) +#if defined(NEED_sv_setpvf_mg) +static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...); +static +#else +extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...); +#endif + +#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg) + +#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL) + +void +DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...) +{ + va_list args; + va_start(args, pat); + sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + SvSETMAGIC(sv); + va_end(args); } -# define grok_oct(string, len, flags, result) \ - _grok_oct((string), (len), (flags), (result)) +#endif +#endif + +/* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */ +#ifdef PERL_IMPLICIT_CONTEXT +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext) +#if defined(NEED_sv_setpvf_mg_nocontext) +static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...); +static +#else +extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...); #endif -#if !defined(grok_bin) && defined(scan_bin) -static UV _grok_bin (char *string, STRLEN *len, I32 *flags, NV *result) { - NV r = scan_bin(string, *len, I32_CAST len); - if (r > UV_MAX) { - *flags |= PERL_SCAN_GREATER_THAN_UV_MAX; - if (result) *result = r; - return UV_MAX; - } - return (UV)r; +#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) +#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) + +#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL) + +void +DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...) +{ + dTHX; + va_list args; + va_start(args, pat); + sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + SvSETMAGIC(sv); + va_end(args); } -# define grok_bin(string, len, flags, result) \ - _grok_bin((string), (len), (flags), (result)) +#endif +#endif #endif -#ifndef IN_LOCALE -# define IN_LOCALE \ - (PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) +#ifndef sv_setpvf_mg +# ifdef PERL_IMPLICIT_CONTEXT +# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext +# else +# define sv_setpvf_mg Perl_sv_setpvf_mg +# endif +#endif + +/* sv_vsetpvf_mg depends on sv_vsetpvfn */ +#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg) +# define sv_vsetpvf_mg(sv, pat, args) \ + STMT_START { \ + sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ + SvSETMAGIC(sv); \ + } STMT_END +#endif +#ifndef SvGETMAGIC +# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END +#endif +#ifndef PERL_MAGIC_sv +# define PERL_MAGIC_sv '\0' +#endif + +#ifndef PERL_MAGIC_overload +# define PERL_MAGIC_overload 'A' +#endif + +#ifndef PERL_MAGIC_overload_elem +# define PERL_MAGIC_overload_elem 'a' +#endif + +#ifndef PERL_MAGIC_overload_table +# define PERL_MAGIC_overload_table 'c' +#endif + +#ifndef PERL_MAGIC_bm +# define PERL_MAGIC_bm 'B' +#endif + +#ifndef PERL_MAGIC_regdata +# define PERL_MAGIC_regdata 'D' +#endif + +#ifndef PERL_MAGIC_regdatum +# define PERL_MAGIC_regdatum 'd' +#endif + +#ifndef PERL_MAGIC_env +# define PERL_MAGIC_env 'E' +#endif + +#ifndef PERL_MAGIC_envelem +# define PERL_MAGIC_envelem 'e' +#endif + +#ifndef PERL_MAGIC_fm +# define PERL_MAGIC_fm 'f' +#endif + +#ifndef PERL_MAGIC_regex_global +# define PERL_MAGIC_regex_global 'g' +#endif + +#ifndef PERL_MAGIC_isa +# define PERL_MAGIC_isa 'I' +#endif + +#ifndef PERL_MAGIC_isaelem +# define PERL_MAGIC_isaelem 'i' +#endif + +#ifndef PERL_MAGIC_nkeys +# define PERL_MAGIC_nkeys 'k' +#endif + +#ifndef PERL_MAGIC_dbfile +# define PERL_MAGIC_dbfile 'L' +#endif + +#ifndef PERL_MAGIC_dbline +# define PERL_MAGIC_dbline 'l' +#endif + +#ifndef PERL_MAGIC_mutex +# define PERL_MAGIC_mutex 'm' +#endif + +#ifndef PERL_MAGIC_shared +# define PERL_MAGIC_shared 'N' +#endif + +#ifndef PERL_MAGIC_shared_scalar +# define PERL_MAGIC_shared_scalar 'n' +#endif + +#ifndef PERL_MAGIC_collxfrm +# define PERL_MAGIC_collxfrm 'o' +#endif + +#ifndef PERL_MAGIC_tied +# define PERL_MAGIC_tied 'P' +#endif + +#ifndef PERL_MAGIC_tiedelem +# define PERL_MAGIC_tiedelem 'p' +#endif + +#ifndef PERL_MAGIC_tiedscalar +# define PERL_MAGIC_tiedscalar 'q' +#endif + +#ifndef PERL_MAGIC_qr +# define PERL_MAGIC_qr 'r' +#endif + +#ifndef PERL_MAGIC_sig +# define PERL_MAGIC_sig 'S' +#endif + +#ifndef PERL_MAGIC_sigelem +# define PERL_MAGIC_sigelem 's' +#endif + +#ifndef PERL_MAGIC_taint +# define PERL_MAGIC_taint 't' +#endif + +#ifndef PERL_MAGIC_uvar +# define PERL_MAGIC_uvar 'U' +#endif + +#ifndef PERL_MAGIC_uvar_elem +# define PERL_MAGIC_uvar_elem 'u' +#endif + +#ifndef PERL_MAGIC_vstring +# define PERL_MAGIC_vstring 'V' +#endif + +#ifndef PERL_MAGIC_vec +# define PERL_MAGIC_vec 'v' +#endif + +#ifndef PERL_MAGIC_utf8 +# define PERL_MAGIC_utf8 'w' +#endif + +#ifndef PERL_MAGIC_substr +# define PERL_MAGIC_substr 'x' +#endif + +#ifndef PERL_MAGIC_defelem +# define PERL_MAGIC_defelem 'y' +#endif + +#ifndef PERL_MAGIC_glob +# define PERL_MAGIC_glob '*' +#endif + +#ifndef PERL_MAGIC_arylen +# define PERL_MAGIC_arylen '#' +#endif + +#ifndef PERL_MAGIC_pos +# define PERL_MAGIC_pos '.' +#endif + +#ifndef PERL_MAGIC_backref +# define PERL_MAGIC_backref '<' +#endif + +#ifndef PERL_MAGIC_ext +# define PERL_MAGIC_ext '~' +#endif + +/* That's the best we can do... */ +#ifndef SvPV_force_nomg +# define SvPV_force_nomg SvPV_force +#endif + +#ifndef SvPV_nomg +# define SvPV_nomg SvPV +#endif + +#ifndef sv_catpvn_nomg +# define sv_catpvn_nomg sv_catpvn +#endif + +#ifndef sv_catsv_nomg +# define sv_catsv_nomg sv_catsv +#endif + +#ifndef sv_setsv_nomg +# define sv_setsv_nomg sv_setsv +#endif + +#ifndef sv_pvn_nomg +# define sv_pvn_nomg sv_pvn +#endif + +#ifndef SvIV_nomg +# define SvIV_nomg SvIV +#endif + +#ifndef SvUV_nomg +# define SvUV_nomg SvUV +#endif + +#ifndef sv_catpv_mg +# define sv_catpv_mg(sv, ptr) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_catpv(TeMpSv,ptr); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_catpvn_mg +# define sv_catpvn_mg(sv, ptr, len) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_catpvn(TeMpSv,ptr,len); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_catsv_mg +# define sv_catsv_mg(dsv, ssv) \ + STMT_START { \ + SV *TeMpSv = dsv; \ + sv_catsv(TeMpSv,ssv); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setiv_mg +# define sv_setiv_mg(sv, i) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setiv(TeMpSv,i); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setnv_mg +# define sv_setnv_mg(sv, num) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setnv(TeMpSv,num); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setpv_mg +# define sv_setpv_mg(sv, ptr) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setpv(TeMpSv,ptr); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setpvn_mg +# define sv_setpvn_mg(sv, ptr, len) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setpvn(TeMpSv,ptr,len); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setsv_mg +# define sv_setsv_mg(dsv, ssv) \ + STMT_START { \ + SV *TeMpSv = dsv; \ + sv_setsv(TeMpSv,ssv); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setuv_mg +# define sv_setuv_mg(sv, i) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setuv(TeMpSv,i); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_usepvn_mg +# define sv_usepvn_mg(sv, ptr, len) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_usepvn(TeMpSv,ptr,len); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifdef USE_ITHREADS +#ifndef CopFILE +# define CopFILE(c) ((c)->cop_file) +#endif + +#ifndef CopFILEGV +# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv) +#endif + +#ifndef CopFILE_set +# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) +#endif + +#ifndef CopFILESV +# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) +#endif + +#ifndef CopFILEAV +# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) +#endif + +#ifndef CopSTASHPV +# define CopSTASHPV(c) ((c)->cop_stashpv) +#endif + +#ifndef CopSTASHPV_set +# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch)) +#endif + +#ifndef CopSTASH +# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv) +#endif + +#ifndef CopSTASH_set +# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch) +#endif + +#ifndef CopSTASH_eq +# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \ + || (CopSTASHPV(c) && HvNAME(hv) \ + && strEQ(CopSTASHPV(c), HvNAME(hv))))) +#endif + +#else +#ifndef CopFILEGV +# define CopFILEGV(c) ((c)->cop_filegv) +#endif + +#ifndef CopFILEGV_set +# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) +#endif + +#ifndef CopFILE_set +# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) +#endif + +#ifndef CopFILESV +# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) +#endif + +#ifndef CopFILEAV +# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) +#endif + +#ifndef CopFILE +# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) +#endif + +#ifndef CopSTASH +# define CopSTASH(c) ((c)->cop_stash) +#endif + +#ifndef CopSTASH_set +# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) +#endif + +#ifndef CopSTASHPV +# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) +#endif + +#ifndef CopSTASHPV_set +# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) +#endif + +#ifndef CopSTASH_eq +# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) +#endif + +#endif /* USE_ITHREADS */ +#ifndef IN_PERL_COMPILETIME +# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) #endif #ifndef IN_LOCALE_RUNTIME -# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) +# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) #endif #ifndef IN_LOCALE_COMPILETIME -# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) +# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) #endif - +#ifndef IN_LOCALE +# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) +#endif #ifndef IS_NUMBER_IN_UV -# define IS_NUMBER_IN_UV 0x01 -# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 -# define IS_NUMBER_NOT_INT 0x04 -# define IS_NUMBER_NEG 0x08 -# define IS_NUMBER_INFINITY 0x10 -# define IS_NUMBER_NAN 0x20 +# define IS_NUMBER_IN_UV 0x01 #endif - + +#ifndef IS_NUMBER_GREATER_THAN_UV_MAX +# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 +#endif + +#ifndef IS_NUMBER_NOT_INT +# define IS_NUMBER_NOT_INT 0x04 +#endif + +#ifndef IS_NUMBER_NEG +# define IS_NUMBER_NEG 0x08 +#endif + +#ifndef IS_NUMBER_INFINITY +# define IS_NUMBER_INFINITY 0x10 +#endif + +#ifndef IS_NUMBER_NAN +# define IS_NUMBER_NAN 0x20 +#endif + +/* GROK_NUMERIC_RADIX depends on grok_numeric_radix */ +#ifndef GROK_NUMERIC_RADIX +# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) +#endif +#ifndef PERL_SCAN_GREATER_THAN_UV_MAX +# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 +#endif + +#ifndef PERL_SCAN_SILENT_ILLDIGIT +# define PERL_SCAN_SILENT_ILLDIGIT 0x04 +#endif + +#ifndef PERL_SCAN_ALLOW_UNDERSCORES +# define PERL_SCAN_ALLOW_UNDERSCORES 0x01 +#endif + +#ifndef PERL_SCAN_DISALLOW_PREFIX +# define PERL_SCAN_DISALLOW_PREFIX 0x02 +#endif + #ifndef grok_numeric_radix -# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(aTHX_ sp, send) +#if defined(NEED_grok_numeric_radix) +static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send); +static +#else +extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send); +#endif -#define grok_numeric_radix Perl_grok_numeric_radix - +#ifdef grok_numeric_radix +# undef grok_numeric_radix +#endif +#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b) +#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix) + +#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL) bool -Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send) +DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send) { #ifdef USE_LOCALE_NUMERIC -#if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1)) +#ifdef PL_numeric_radix_sv if (PL_numeric_radix_sv && IN_LOCALE) { STRLEN len; char* radix = SvPV(PL_numeric_radix_sv, len); @@ -913,9 +5175,11 @@ Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send) } } #else - /* pre5.6.0 perls don't have PL_numeric_radix_sv so the radix - * must manually be requested from locale.h */ + /* older perls don't have PL_numeric_radix_sv so the radix + * must manually be requested from locale.h + */ #include <locale.h> + dTHR; /* needed for older threaded perls */ struct lconv *lc = localeconv(); char *radix = lc->decimal_point; if (radix && IN_LOCALE) { @@ -935,14 +5199,28 @@ Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send) } return FALSE; } -#endif /* grok_numeric_radix */ +#endif +#endif + +/* grok_number depends on grok_numeric_radix */ #ifndef grok_number +#if defined(NEED_grok_number) +static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep); +static +#else +extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep); +#endif -#define grok_number Perl_grok_number +#ifdef grok_number +# undef grok_number +#endif +#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c) +#define Perl_grok_number DPPP_(my_grok_number) +#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL) int -Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) +DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep) { const char *s = pv; const char *send = pv + len; @@ -988,7 +5266,7 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; - if (++s < send) { + if (++s < send) { digit = *s - '0'; if (digit >= 0 && digit <= 9) { value = value * 10 + digit; @@ -1036,7 +5314,7 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) } } } - } + } } } } @@ -1048,7 +5326,7 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) } } } - } + } } } numtype |= IS_NUMBER_IN_UV; @@ -1131,162 +5409,310 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) } return 0; } -#endif /* grok_number */ - -#ifndef PERL_MAGIC_sv -# define PERL_MAGIC_sv '\0' -#endif - -#ifndef PERL_MAGIC_overload -# define PERL_MAGIC_overload 'A' -#endif - -#ifndef PERL_MAGIC_overload_elem -# define PERL_MAGIC_overload_elem 'a' -#endif - -#ifndef PERL_MAGIC_overload_table -# define PERL_MAGIC_overload_table 'c' -#endif - -#ifndef PERL_MAGIC_bm -# define PERL_MAGIC_bm 'B' -#endif - -#ifndef PERL_MAGIC_regdata -# define PERL_MAGIC_regdata 'D' -#endif - -#ifndef PERL_MAGIC_regdatum -# define PERL_MAGIC_regdatum 'd' -#endif - -#ifndef PERL_MAGIC_env -# define PERL_MAGIC_env 'E' -#endif - -#ifndef PERL_MAGIC_envelem -# define PERL_MAGIC_envelem 'e' -#endif - -#ifndef PERL_MAGIC_fm -# define PERL_MAGIC_fm 'f' -#endif - -#ifndef PERL_MAGIC_regex_global -# define PERL_MAGIC_regex_global 'g' -#endif - -#ifndef PERL_MAGIC_isa -# define PERL_MAGIC_isa 'I' -#endif - -#ifndef PERL_MAGIC_isaelem -# define PERL_MAGIC_isaelem 'i' -#endif - -#ifndef PERL_MAGIC_nkeys -# define PERL_MAGIC_nkeys 'k' -#endif - -#ifndef PERL_MAGIC_dbfile -# define PERL_MAGIC_dbfile 'L' -#endif - -#ifndef PERL_MAGIC_dbline -# define PERL_MAGIC_dbline 'l' -#endif - -#ifndef PERL_MAGIC_mutex -# define PERL_MAGIC_mutex 'm' -#endif - -#ifndef PERL_MAGIC_shared -# define PERL_MAGIC_shared 'N' -#endif - -#ifndef PERL_MAGIC_shared_scalar -# define PERL_MAGIC_shared_scalar 'n' -#endif - -#ifndef PERL_MAGIC_collxfrm -# define PERL_MAGIC_collxfrm 'o' #endif - -#ifndef PERL_MAGIC_tied -# define PERL_MAGIC_tied 'P' #endif -#ifndef PERL_MAGIC_tiedelem -# define PERL_MAGIC_tiedelem 'p' -#endif +/* + * The grok_* routines have been modified to use warn() instead of + * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit, + * which is why the stack variable has been renamed to 'xdigit'. + */ -#ifndef PERL_MAGIC_tiedscalar -# define PERL_MAGIC_tiedscalar 'q' +#ifndef grok_bin +#if defined(NEED_grok_bin) +static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); +static +#else +extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); #endif -#ifndef PERL_MAGIC_qr -# define PERL_MAGIC_qr 'r' +#ifdef grok_bin +# undef grok_bin #endif +#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d) +#define Perl_grok_bin DPPP_(my_grok_bin) -#ifndef PERL_MAGIC_sig -# define PERL_MAGIC_sig 'S' -#endif +#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL) +UV +DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) +{ + const char *s = start; + STRLEN len = *len_p; + UV value = 0; + NV value_nv = 0; + + const UV max_div_2 = UV_MAX / 2; + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; + bool overflowed = FALSE; + + if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { + /* strip off leading b or 0b. + for compatibility silently suffer "b" and "0b" as valid binary + numbers. */ + if (len >= 1) { + if (s[0] == 'b') { + s++; + len--; + } + else if (len >= 2 && s[0] == '0' && s[1] == 'b') { + s+=2; + len-=2; + } + } + } -#ifndef PERL_MAGIC_sigelem -# define PERL_MAGIC_sigelem 's' + for (; len-- && *s; s++) { + char bit = *s; + if (bit == '0' || bit == '1') { + /* Write it in this wonky order with a goto to attempt to get the + compiler to make the common case integer-only loop pretty tight. + With gcc seems to be much straighter code than old scan_bin. */ + redo: + if (!overflowed) { + if (value <= max_div_2) { + value = (value << 1) | (bit - '0'); + continue; + } + /* Bah. We're just overflowed. */ + warn("Integer overflow in binary number"); + overflowed = TRUE; + value_nv = (NV) value; + } + value_nv *= 2.0; + /* If an NV has not enough bits in its mantissa to + * represent a UV this summing of small low-order numbers + * is a waste of time (because the NV cannot preserve + * the low-order bits anyway): we could just remember when + * did we overflow and in the end just multiply value_nv by the + * right amount. */ + value_nv += (NV)(bit - '0'); + continue; + } + if (bit == '_' && len && allow_underscores && (bit = s[1]) + && (bit == '0' || bit == '1')) + { + --len; + ++s; + goto redo; + } + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + warn("Illegal binary digit '%c' ignored", *s); + break; + } + + if ( ( overflowed && value_nv > 4294967295.0) +#if UVSIZE > 4 + || (!overflowed && value > 0xffffffff ) #endif - -#ifndef PERL_MAGIC_taint -# define PERL_MAGIC_taint 't' + ) { + warn("Binary number > 0b11111111111111111111111111111111 non-portable"); + } + *len_p = s - start; + if (!overflowed) { + *flags = 0; + return value; + } + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; + if (result) + *result = value_nv; + return UV_MAX; +} #endif - -#ifndef PERL_MAGIC_uvar -# define PERL_MAGIC_uvar 'U' #endif -#ifndef PERL_MAGIC_uvar_elem -# define PERL_MAGIC_uvar_elem 'u' +#ifndef grok_hex +#if defined(NEED_grok_hex) +static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); +static +#else +extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); #endif -#ifndef PERL_MAGIC_vstring -# define PERL_MAGIC_vstring 'V' +#ifdef grok_hex +# undef grok_hex #endif +#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d) +#define Perl_grok_hex DPPP_(my_grok_hex) -#ifndef PERL_MAGIC_vec -# define PERL_MAGIC_vec 'v' -#endif +#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL) +UV +DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) +{ + const char *s = start; + STRLEN len = *len_p; + UV value = 0; + NV value_nv = 0; + + const UV max_div_16 = UV_MAX / 16; + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; + bool overflowed = FALSE; + const char *xdigit; + + if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { + /* strip off leading x or 0x. + for compatibility silently suffer "x" and "0x" as valid hex numbers. + */ + if (len >= 1) { + if (s[0] == 'x') { + s++; + len--; + } + else if (len >= 2 && s[0] == '0' && s[1] == 'x') { + s+=2; + len-=2; + } + } + } -#ifndef PERL_MAGIC_utf8 -# define PERL_MAGIC_utf8 'w' + for (; len-- && *s; s++) { + xdigit = strchr((char *) PL_hexdigit, *s); + if (xdigit) { + /* Write it in this wonky order with a goto to attempt to get the + compiler to make the common case integer-only loop pretty tight. + With gcc seems to be much straighter code than old scan_hex. */ + redo: + if (!overflowed) { + if (value <= max_div_16) { + value = (value << 4) | ((xdigit - PL_hexdigit) & 15); + continue; + } + warn("Integer overflow in hexadecimal number"); + overflowed = TRUE; + value_nv = (NV) value; + } + value_nv *= 16.0; + /* If an NV has not enough bits in its mantissa to + * represent a UV this summing of small low-order numbers + * is a waste of time (because the NV cannot preserve + * the low-order bits anyway): we could just remember when + * did we overflow and in the end just multiply value_nv by the + * right amount of 16-tuples. */ + value_nv += (NV)((xdigit - PL_hexdigit) & 15); + continue; + } + if (*s == '_' && len && allow_underscores && s[1] + && (xdigit = strchr((char *) PL_hexdigit, s[1]))) + { + --len; + ++s; + goto redo; + } + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + warn("Illegal hexadecimal digit '%c' ignored", *s); + break; + } + + if ( ( overflowed && value_nv > 4294967295.0) +#if UVSIZE > 4 + || (!overflowed && value > 0xffffffff ) #endif - -#ifndef PERL_MAGIC_substr -# define PERL_MAGIC_substr 'x' + ) { + warn("Hexadecimal number > 0xffffffff non-portable"); + } + *len_p = s - start; + if (!overflowed) { + *flags = 0; + return value; + } + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; + if (result) + *result = value_nv; + return UV_MAX; +} #endif - -#ifndef PERL_MAGIC_defelem -# define PERL_MAGIC_defelem 'y' #endif -#ifndef PERL_MAGIC_glob -# define PERL_MAGIC_glob '*' +#ifndef grok_oct +#if defined(NEED_grok_oct) +static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); +static +#else +extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); #endif -#ifndef PERL_MAGIC_arylen -# define PERL_MAGIC_arylen '#' +#ifdef grok_oct +# undef grok_oct #endif +#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d) +#define Perl_grok_oct DPPP_(my_grok_oct) -#ifndef PERL_MAGIC_pos -# define PERL_MAGIC_pos '.' +#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL) +UV +DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) +{ + const char *s = start; + STRLEN len = *len_p; + UV value = 0; + NV value_nv = 0; + + const UV max_div_8 = UV_MAX / 8; + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; + bool overflowed = FALSE; + + for (; len-- && *s; s++) { + /* gcc 2.95 optimiser not smart enough to figure that this subtraction + out front allows slicker code. */ + int digit = *s - '0'; + if (digit >= 0 && digit <= 7) { + /* Write it in this wonky order with a goto to attempt to get the + compiler to make the common case integer-only loop pretty tight. + */ + redo: + if (!overflowed) { + if (value <= max_div_8) { + value = (value << 3) | digit; + continue; + } + /* Bah. We're just overflowed. */ + warn("Integer overflow in octal number"); + overflowed = TRUE; + value_nv = (NV) value; + } + value_nv *= 8.0; + /* If an NV has not enough bits in its mantissa to + * represent a UV this summing of small low-order numbers + * is a waste of time (because the NV cannot preserve + * the low-order bits anyway): we could just remember when + * did we overflow and in the end just multiply value_nv by the + * right amount of 8-tuples. */ + value_nv += (NV)digit; + continue; + } + if (digit == ('_' - '0') && len && allow_underscores + && (digit = s[1] - '0') && (digit >= 0 && digit <= 7)) + { + --len; + ++s; + goto redo; + } + /* Allow \octal to work the DWIM way (that is, stop scanning + * as soon as non-octal characters are seen, complain only iff + * someone seems to want to use the digits eight and nine). */ + if (digit == 8 || digit == 9) { + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + warn("Illegal octal digit '%c' ignored", *s); + } + break; + } + + if ( ( overflowed && value_nv > 4294967295.0) +#if UVSIZE > 4 + || (!overflowed && value > 0xffffffff ) #endif - -#ifndef PERL_MAGIC_backref -# define PERL_MAGIC_backref '<' + ) { + warn("Octal number > 037777777777 non-portable"); + } + *len_p = s - start; + if (!overflowed) { + *flags = 0; + return value; + } + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; + if (result) + *result = value_nv; + return UV_MAX; +} #endif - -#ifndef PERL_MAGIC_ext -# define PERL_MAGIC_ext '~' #endif #endif /* _P_P_PORTABILITY_H_ */ diff --git a/gnu/usr.bin/perl/ext/Devel/PPPort/t/test.t b/gnu/usr.bin/perl/ext/Devel/PPPort/t/test.t deleted file mode 100644 index f0f30352d75..00000000000 --- a/gnu/usr.bin/perl/ext/Devel/PPPort/t/test.t +++ /dev/null @@ -1,96 +0,0 @@ -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib' if -d '../lib'; -} - -use Devel::PPPort; -use strict; - -print "1..17\n"; - -my $total = 0; -my $good = 0; - -my $test = 0; -sub ok { - my ($name, $test_sub) = @_; - my $line = (caller)[2]; - my $value; - - eval { $value = &{ $test_sub }() } ; - - ++ $test ; - - if ($@) { - printf "not ok $test # Testing '$name', line $line $@\n"; - } - elsif ($value != 1){ - printf "not ok $test # Testing '$name', line $line, value != 1 ($value)\n"; - } - else { - print "ok $test\n"; - } - -} - -ok "Static newCONSTSUB()", - sub { Devel::PPPort::test1(); Devel::PPPort::test_value_1() == 1} ; - -ok "Global newCONSTSUB()", - sub { Devel::PPPort::test2(); Devel::PPPort::test_value_2() == 2} ; - -ok "Extern newCONSTSUB()", - sub { Devel::PPPort::test3(); Devel::PPPort::test_value_3() == 3} ; - -ok "newRV_inc()", sub { Devel::PPPort::test4()} ; - -ok "newRV_noinc()", sub { Devel::PPPort::test5()} ; - -ok "PL_sv_undef", sub { not defined Devel::PPPort::test6()} ; - -ok "PL_sv_yes", sub { Devel::PPPort::test7()} ; - -ok "PL_sv_no", sub { !Devel::PPPort::test8()} ; - -ok "PL_na", sub { Devel::PPPort::test9("abcd") == 4} ; - -ok "boolSV 1", sub { Devel::PPPort::test10(1) } ; - -ok "boolSV 0", sub { ! Devel::PPPort::test10(0) } ; - -ok "newSVpvn", sub { Devel::PPPort::test11("abcde", 3) eq "abc" } ; - -ok "DEFSV", sub { $_ = "Fred"; Devel::PPPort::test12() eq "Fred" } ; - -ok "ERRSV", sub { eval { 1; }; ! Devel::PPPort::test13() }; - -ok "ERRSV", sub { eval { fred() }; Devel::PPPort::test13() }; - -ok "CXT 1", sub { Devel::PPPort::test14()} ; - -ok "CXT 2", sub { Devel::PPPort::test15()} ; - -__END__ -# TODO - -PERL_VERSION -PERL_BCDVERSION - -PL_stdingv -PL_hints -PL_curcop -PL_curstash -PL_copline -PL_Sv -PL_compiling -PL_dirty - -PTR2IV -INT2PTR - -dTHR -gv_stashpvn -NOOP -SAVE_DEFSV -PERL_UNUSED_DECL -dNOOP diff --git a/gnu/usr.bin/perl/ext/Encode/bin/ucmsort b/gnu/usr.bin/perl/ext/Encode/bin/ucmsort index 774f62528a2..1987bc0bd7d 100644 --- a/gnu/usr.bin/perl/ext/Encode/bin/ucmsort +++ b/gnu/usr.bin/perl/ext/Encode/bin/ucmsort @@ -1,6 +1,6 @@ #!/usr/local/bin/perl # -# $Id: ucmsort,v 1.2 2003/12/03 03:02:28 millert Exp $ +# $Id: ucmsort,v 1.3 2005/01/15 21:30:26 millert Exp $ # use strict; my @lines; @@ -15,17 +15,21 @@ while (<>){ next; } chomp; - push @lines,[ split ]; + my @words = split; + my $u = shift @words; + $u =~ s/^<U//o; $u =~ s/>.*//o; + push @lines,[ $u, @words ]; } print $head; for (sort { - $a->[0] cmp $b->[0] # Unicode descending order + hex($a->[0]) <=> hex($b->[0]) # Unicode descending order or $a->[2] cmp $b->[2] # fallback descending order - or $a->[1] cmp $b->[1] # Encoding descending order - } - @lines) { - print join(" " => @$_), "\n"; + or $a->[1] cmp $b->[1] # Encoding descending order + } + @lines) { + my $u = shift @$_; + print join(" " => "<U$u>", @$_), "\n"; } print $tail; __END__ diff --git a/gnu/usr.bin/perl/ext/Encode/lib/Encode/Supported.pod b/gnu/usr.bin/perl/ext/Encode/lib/Encode/Supported.pod index 9280a97e721..7a535c6d58e 100644 --- a/gnu/usr.bin/perl/ext/Encode/lib/Encode/Supported.pod +++ b/gnu/usr.bin/perl/ext/Encode/lib/Encode/Supported.pod @@ -664,7 +664,8 @@ probably has more rights for the name, though it may be objected that Microsoft shouldn't have used JIS as part of the name in the first place. -Unambiguous name: C<CP932>. C<IANA> name (not used?): C<Windows-31J>. +Unambiguous name: C<CP932>. C<IANA> name (also used by Mozilla, and +provided as an alias by Encode): C<Windows-31J>. Encode separately supports C<Shift_JIS> and C<cp932>. diff --git a/gnu/usr.bin/perl/ext/IO/IO.xs b/gnu/usr.bin/perl/ext/IO/IO.xs index 4f713a09175..39e4486f995 100644 --- a/gnu/usr.bin/perl/ext/IO/IO.xs +++ b/gnu/usr.bin/perl/ext/IO/IO.xs @@ -73,53 +73,24 @@ io_blocking(pTHX_ InputStream f, int block) RETVAL = fcntl(PerlIO_fileno(f), F_GETFL, 0); if (RETVAL >= 0) { int mode = RETVAL; + int newmode = mode; #ifdef O_NONBLOCK /* POSIX style */ -#if defined(O_NDELAY) && O_NDELAY != O_NONBLOCK - /* Ooops has O_NDELAY too - make sure we don't - * get SysV behaviour by mistake. */ - /* E.g. In UNICOS and UNICOS/mk a F_GETFL returns an O_NDELAY +# ifndef O_NDELAY +# define O_NDELAY O_NONBLOCK +# endif + /* Note: UNICOS and UNICOS/mk a F_GETFL returns an O_NDELAY * after a successful F_SETFL of an O_NONBLOCK. */ RETVAL = RETVAL & (O_NONBLOCK | O_NDELAY) ? 0 : 1; - if (block >= 0) { - if ((mode & O_NDELAY) || ((block == 0) && !(mode & O_NONBLOCK))) { - int ret; - mode = (mode & ~O_NDELAY) | O_NONBLOCK; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } - else - if ((mode & O_NDELAY) || ((block > 0) && (mode & O_NONBLOCK))) { - int ret; - mode &= ~(O_NONBLOCK | O_NDELAY); - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } + if (block == 0) { + newmode &= ~O_NDELAY; + newmode |= O_NONBLOCK; + } else if (block > 0) { + newmode &= ~(O_NDELAY|O_NONBLOCK); } #else - /* Standard POSIX */ - RETVAL = RETVAL & O_NONBLOCK ? 0 : 1; - - if ((block == 0) && !(mode & O_NONBLOCK)) { - int ret; - mode |= O_NONBLOCK; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } - else if ((block > 0) && (mode & O_NONBLOCK)) { - int ret; - mode &= ~O_NONBLOCK; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } -#endif -#else /* Not POSIX - better have O_NDELAY or we can't cope. * for BSD-ish machines this is an acceptable alternative * for SysV we can't tell "would block" from EOF but that is @@ -127,21 +98,18 @@ io_blocking(pTHX_ InputStream f, int block) */ RETVAL = RETVAL & O_NDELAY ? 0 : 1; - if ((block == 0) && !(mode & O_NDELAY)) { - int ret; - mode |= O_NDELAY; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } - else if ((block > 0) && (mode & O_NDELAY)) { + if (block == 0) { + newmode |= O_NDELAY; + } else if (block > 0) { + newmode &= ~O_NDELAY; + } +#endif + if (newmode != mode) { int ret; - mode &= ~O_NDELAY; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) + ret = fcntl(PerlIO_fileno(f),F_SETFL,newmode); + if (ret < 0) RETVAL = ret; - } -#endif + } } return RETVAL; #else diff --git a/gnu/usr.bin/perl/ext/IO/lib/IO/File.pm b/gnu/usr.bin/perl/ext/IO/lib/IO/File.pm index 538efcd0b68..0006eb35161 100644 --- a/gnu/usr.bin/perl/ext/IO/lib/IO/File.pm +++ b/gnu/usr.bin/perl/ext/IO/lib/IO/File.pm @@ -169,7 +169,7 @@ sub open { if (defined($file) && length($file) && ! File::Spec->file_name_is_absolute($file)) { - $file = File::Spec->catfile(File::Spec->curdir(),$file); + $file = File::Spec->rel2abs($file); } $file = IO::Handle::_open_mode_string($mode) . " $file\0"; } diff --git a/gnu/usr.bin/perl/ext/NDBM_File/Makefile.PL b/gnu/usr.bin/perl/ext/NDBM_File/Makefile.PL index ca4c107c0d2..4671d2b7162 100644 --- a/gnu/usr.bin/perl/ext/NDBM_File/Makefile.PL +++ b/gnu/usr.bin/perl/ext/NDBM_File/Makefile.PL @@ -1,8 +1,9 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'NDBM_File', - LIBS => ["-L/usr/local/lib -lndbm", "-ldbm -lucb"], - MAN3PODS => ' ', # Pods will be built by installman. + #LIBS => ["-L/usr/local/lib -lndbm", "-ldbm -lucb"], + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'NDBM_File.pm', + INC => ($^O eq "MacOS" ? "-i ::::db:include" : "") ); diff --git a/gnu/usr.bin/perl/ext/POSIX/POSIX.pod b/gnu/usr.bin/perl/ext/POSIX/POSIX.pod index 66f5381949f..d7fa8f30f50 100644 --- a/gnu/usr.bin/perl/ext/POSIX/POSIX.pod +++ b/gnu/usr.bin/perl/ext/POSIX/POSIX.pod @@ -955,9 +955,9 @@ variable instead, see L<perlfunc/warn> and L<perlvar/$ERRNO>. Create an interprocess channel. This returns file descriptors like those returned by C<POSIX::open>. - ($fd0, $fd1) = POSIX::pipe(); - POSIX::write( $fd0, "hello", 5 ); - POSIX::read( $fd1, $buf, 5 ); + my ($read, $write) = POSIX::pipe(); + POSIX::write( $write, "hello", 5 ); + POSIX::read( $read, $buf, 5 ); See also L<perlfunc/pipe>. diff --git a/gnu/usr.bin/perl/ext/POSIX/POSIX.xs b/gnu/usr.bin/perl/ext/POSIX/POSIX.xs index d56c3795888..4703dcf0058 100644 --- a/gnu/usr.bin/perl/ext/POSIX/POSIX.xs +++ b/gnu/usr.bin/perl/ext/POSIX/POSIX.xs @@ -1390,20 +1390,25 @@ sigpending(sigset) SysRet sigprocmask(how, sigset, oldsigset = 0) int how - POSIX::SigSet sigset + POSIX::SigSet sigset = NO_INIT POSIX::SigSet oldsigset = NO_INIT INIT: - if ( items < 3 ) { - oldsigset = 0; + if (! SvOK(ST(1))) { + sigset = NULL; + } else if (sv_isa(ST(1), "POSIX::SigSet")) { + IV tmp = SvIV((SV*)SvRV(ST(1))); + sigset = INT2PTR(POSIX__SigSet,tmp); + } else { + croak("sigset is not of type POSIX::SigSet"); } - else if (sv_derived_from(ST(2), "POSIX::SigSet")) { + + if (items < 3 || ! SvOK(ST(2))) { + oldsigset = NULL; + } else if (sv_isa(ST(2), "POSIX::SigSet")) { IV tmp = SvIV((SV*)SvRV(ST(2))); oldsigset = INT2PTR(POSIX__SigSet,tmp); - } - else { - New(0, oldsigset, 1, sigset_t); - sigemptyset(oldsigset); - sv_setref_pv(ST(2), "POSIX::SigSet", (void*)oldsigset); + } else { + croak("oldsigset is not of type POSIX::SigSet"); } SysRet diff --git a/gnu/usr.bin/perl/ext/Sys/Syslog/Syslog.pm b/gnu/usr.bin/perl/ext/Sys/Syslog/Syslog.pm index 244157f755e..551a885eb89 100644 --- a/gnu/usr.bin/perl/ext/Sys/Syslog/Syslog.pm +++ b/gnu/usr.bin/perl/ext/Sys/Syslog/Syslog.pm @@ -128,6 +128,12 @@ Note that C<openlog> now takes three arguments, just like C<openlog(3)>. $! = 55; syslog('info', 'problem was %m'); # %m == $! in syslog(3) + # Log to UDP port on $remotehost instead of logging locally + setlogsock('udp'); + $Sys::Syslog::host = $remotehost; + openlog($program, 'ndelay', 'user'); + syslog('info', 'something happened over here'); + =head1 SEE ALSO L<syslog(3)> diff --git a/gnu/usr.bin/perl/ext/Time/HiRes/HiRes.pm b/gnu/usr.bin/perl/ext/Time/HiRes/HiRes.pm index de7ddfc0a15..e47e09c75e9 100644 --- a/gnu/usr.bin/perl/ext/Time/HiRes/HiRes.pm +++ b/gnu/usr.bin/perl/ext/Time/HiRes/HiRes.pm @@ -15,7 +15,7 @@ require DynaLoader; d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer d_nanosleep); -$VERSION = '1.59'; +$VERSION = '1.65'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -83,35 +83,38 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers =head1 DESCRIPTION -The C<Time::HiRes> module implements a Perl interface to the C<usleep>, -C<ualarm>, C<gettimeofday>, and C<setitimer>/C<getitimer> system calls, in other -words, high resolution time and timers. See the L</EXAMPLES> section below -and the test scripts for usage; see your system documentation for the -description of the underlying C<nanosleep> or C<usleep>, C<ualarm>, -C<gettimeofday>, and C<setitimer>/C<getitimer> calls. +The C<Time::HiRes> module implements a Perl interface to the +C<usleep>, C<ualarm>, C<gettimeofday>, and C<setitimer>/C<getitimer> +system calls, in other words, high resolution time and timers. See the +L</EXAMPLES> section below and the test scripts for usage; see your +system documentation for the description of the underlying +C<nanosleep> or C<usleep>, C<ualarm>, C<gettimeofday>, and +C<setitimer>/C<getitimer> calls. If your system lacks C<gettimeofday()> or an emulation of it you don't -get C<gettimeofday()> or the one-argument form of C<tv_interval()>. If your system lacks all of -C<nanosleep()>, C<usleep()>, and C<select()>, you don't get -C<Time::HiRes::usleep()> or C<Time::HiRes::sleep()>. If your system lacks both -C<ualarm()> and C<setitimer()> you don't get -C<Time::HiRes::ualarm()> or C<Time::HiRes::alarm()>. +get C<gettimeofday()> or the one-argument form of C<tv_interval()>. +If your system lacks all of C<nanosleep()>, C<usleep()>, and +C<select()>, you don't get C<Time::HiRes::usleep()> or +C<Time::HiRes::sleep()>. If your system lacks both C<ualarm()> and +C<setitimer()> you don't get C<Time::HiRes::ualarm()> or +C<Time::HiRes::alarm()>. If you try to import an unimplemented function in the C<use> statement it will fail at compile time. -If your subsecond sleeping is implemented with C<nanosleep()> instead of -C<usleep()>, you can mix subsecond sleeping with signals since -C<nanosleep()> does not use signals. This, however is unportable, and you -should first check for the truth value of C<&Time::HiRes::d_nanosleep> to -see whether you have nanosleep, and then carefully read your -C<nanosleep()> C API documentation for any peculiarities. (There is no -separate interface to call C<nanosleep()>; just use C<Time::HiRes::sleep()> -or C<Time::HiRes::usleep()> with small enough values.) +If your subsecond sleeping is implemented with C<nanosleep()> instead +of C<usleep()>, you can mix subsecond sleeping with signals since +C<nanosleep()> does not use signals. This, however, is not portable, +and you should first check for the truth value of +C<&Time::HiRes::d_nanosleep> to see whether you have nanosleep, and +then carefully read your C<nanosleep()> C API documentation for any +peculiarities. (There is no separate interface to call +C<nanosleep()>; just use C<Time::HiRes::sleep()> or +C<Time::HiRes::usleep()> with small enough values.) Unless using C<nanosleep> for mixing sleeping with signals, give -some thought to whether Perl is the tool you should be using for work -requiring nanosecond accuracies. +some thought to whether Perl is the tool you should be using for +work requiring nanosecond accuracies. The following functions can be imported from this module. No functions are exported by default. @@ -135,6 +138,8 @@ unlike the C<usleep> system call. See also C<Time::HiRes::sleep()> below. Issues a C<ualarm> call; the C<$interval_useconds> is optional and will be zero if unspecified, resulting in C<alarm>-like behaviour. +Note that the interaction between alarms and sleeps are unspecified. + =item tv_interval tv_interval ( $ref_to_gettimeofday [, $ref_to_later_gettimeofday] ) @@ -159,23 +164,25 @@ B<NOTE 2>: Since Sunday, September 9th, 2001 at 01:46:40 AM GMT, when the C<time()> seconds since epoch rolled over to 1_000_000_000, the default floating point format of Perl and the seconds since epoch have conspired to produce an apparent bug: if you print the value of -C<Time::HiRes::time()> you seem to be getting only five decimals, not six -as promised (microseconds). Not to worry, the microseconds are there -(assuming your platform supports such granularity in first place). -What is going on is that the default floating point format of Perl -only outputs 15 digits. In this case that means ten digits before the -decimal separator and five after. To see the microseconds you can use -either C<printf>/C<sprintf> with C<"%.6f">, or the C<gettimeofday()> function in -list context, which will give you the seconds and microseconds as two -separate values. +C<Time::HiRes::time()> you seem to be getting only five decimals, not +six as promised (microseconds). Not to worry, the microseconds are +there (assuming your platform supports such granularity in the first +place). What is going on is that the default floating point format of +Perl only outputs 15 digits. In this case that means ten digits +before the decimal separator and five after. To see the microseconds +you can use either C<printf>/C<sprintf> with C<"%.6f">, or the +C<gettimeofday()> function in list context, which will give you the +seconds and microseconds as two separate values. =item sleep ( $floating_seconds ) Sleeps for the specified amount of seconds. Returns the number of -seconds actually slept (a floating point value). This function can be -imported, resulting in a nice drop-in replacement for the C<sleep> +seconds actually slept (a floating point value). This function can +be imported, resulting in a nice drop-in replacement for the C<sleep> provided with perl, see the L</EXAMPLES> below. +Note that the interaction between alarms and sleeps are unspecified. + =item alarm ( $floating_seconds [, $interval_floating_seconds ] ) The C<SIGALRM> signal is sent after the specified number of seconds. @@ -184,19 +191,21 @@ is optional and will be zero if unspecified, resulting in C<alarm()>-like behaviour. This function can be imported, resulting in a nice drop-in replacement for the C<alarm> provided with perl, see the L</EXAMPLES> below. -B<NOTE 1>: With some operating system and Perl release combinations -C<SIGALRM> restarts C<select()>, instead of interuping it. -This means that an C<alarm()> followed by a C<select()> -may together take the sum of the times specified for the -C<alarm()> and the C<select()>, not just the time of the C<alarm()>. +B<NOTE 1>: With some combinations of operating systems and Perl +releases C<SIGALRM> restarts C<select()>, instead of interrupting it. +This means that an C<alarm()> followed by a C<select()> may together +take the sum of the times specified for the the C<alarm()> and the +C<select()>, not just the time of the C<alarm()>. + +Note that the interaction between alarms and sleeps are unspecified. =item setitimer ( $which, $floating_seconds [, $interval_floating_seconds ] ) Start up an interval timer: after a certain time, a signal arrives, -and more signals may keep arriving at certain intervals. To disable a -timer, use C<$floating_seconds> of zero. If the C<$interval_floating_seconds> -is set to zero (or unspecified), the timer is disabled B<after> the -next delivered signal. +and more signals may keep arriving at certain intervals. To disable +an "itimer", use C<$floating_seconds> of zero. If the +C<$interval_floating_seconds> is set to zero (or unspecified), the +timer is disabled B<after> the next delivered signal. Use of interval timers may interfere with C<alarm()>, C<sleep()>, and C<usleep()>. In standard-speak the "interaction is unspecified", @@ -206,21 +215,22 @@ In scalar context, the remaining time in the timer is returned. In list context, both the remaining time and the interval are returned. -There are usually three or four interval timers available: the C<$which> -can be C<ITIMER_REAL>, C<ITIMER_VIRTUAL>, C<ITIMER_PROF>, or C<ITIMER_REALPROF>. -Note that which ones are available depends: true UNIX platforms usually -have the first three, but (for example) Win32 and Cygwin have only -C<ITIMER_REAL>, and only Solaris seems to have C<ITIMER_REALPROF> (which is -used to profile multithreaded programs). +There are usually three or four interval timers available: the +C<$which> can be C<ITIMER_REAL>, C<ITIMER_VIRTUAL>, C<ITIMER_PROF>, or +C<ITIMER_REALPROF>. Note that which ones are available depends: true +UNIX platforms usually have the first three, but (for example) Win32 +and Cygwin have only C<ITIMER_REAL>, and only Solaris seems to have +C<ITIMER_REALPROF> (which is used to profile multithreaded programs). C<ITIMER_REAL> results in C<alarm()>-like behavior. Time is counted in I<real time>; that is, wallclock time. C<SIGALRM> is delivered when the timer expires. -C<ITIMER_VIRTUAL> counts time in (process) I<virtual time>; that is, only -when the process is running. In multiprocessor/user/CPU systems this -may be more or less than real or wallclock time. (This time is also -known as the I<user time>.) C<SIGVTALRM> is delivered when the timer expires. +C<ITIMER_VIRTUAL> counts time in (process) I<virtual time>; that is, +only when the process is running. In multiprocessor/user/CPU systems +this may be more or less than real or wallclock time. (This time is +also known as the I<user time>.) C<SIGVTALRM> is delivered when the +timer expires. C<ITIMER_PROF> counts time when either the process virtual time or when the operating system is running on behalf of the process (such as I/O). diff --git a/gnu/usr.bin/perl/gv.c b/gnu/usr.bin/perl/gv.c index 1ce6b4869ca..e2f73992f3a 100644 --- a/gnu/usr.bin/perl/gv.c +++ b/gnu/usr.bin/perl/gv.c @@ -19,6 +19,15 @@ /* =head1 GV Functions + +A GV is a structure which corresponds to to a Perl typeglob, ie *foo. +It is a structure that holds a pointer to a scalar, an array, a hash etc, +corresponding to $foo, @foo, %foo. + +GVs are usually found as values in stashes (symbol table hashes) where +Perl stores its global variables. + +=cut */ #include "EXTERN.h" @@ -1084,7 +1093,7 @@ Perl_gv_fullname4(pTHX_ SV *sv, GV *gv, const char *prefix, bool keepmain) { HV *hv = GvSTASH(gv); if (!hv) { - (void)SvOK_off(sv); + SvOK_off(sv); return; } sv_setpv(sv, prefix ? prefix : ""); diff --git a/gnu/usr.bin/perl/handy.h b/gnu/usr.bin/perl/handy.h index 19a593408ed..e5c7c45c938 100644 --- a/gnu/usr.bin/perl/handy.h +++ b/gnu/usr.bin/perl/handy.h @@ -559,16 +559,30 @@ The XSUB-writer's interface to the C C<memmove> function. The C<src> is the source, C<dest> is the destination, C<nitems> is the number of items, and C<type> is the type. Can do overlapping moves. See also C<Copy>. +=for apidoc Am|void *|MoveD|void* src|void* dest|int nitems|type +Like C<Move> but returns dest. Useful for encouraging compilers to tail-call +optimise. + =for apidoc Am|void|Copy|void* src|void* dest|int nitems|type The XSUB-writer's interface to the C C<memcpy> function. The C<src> is the source, C<dest> is the destination, C<nitems> is the number of items, and C<type> is the type. May fail on overlapping copies. See also C<Move>. +=for apidoc Am|void *|CopyD|void* src|void* dest|int nitems|type + +Like C<Copy> but returns dest. Useful for encouraging compilers to tail-call +optimise. + =for apidoc Am|void|Zero|void* dest|int nitems|type The XSUB-writer's interface to the C C<memzero> function. The C<dest> is the destination, C<nitems> is the number of items, and C<type> is the type. +=for apidoc Am|void *|ZeroD|void* dest|int nitems|type + +Like C<Zero> but returns dest. Useful for encouraging compilers to tail-call +optimise. + =for apidoc Am|void|StructCopy|type src|type dest|type This is an architecture-independent macro to copy one structure to another. @@ -605,6 +619,15 @@ hopefully catches attempts to access uninitialized memory. #define Copy(s,d,n,t) (MEM_WRAP_CHECK(n,t), (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))) #define Zero(d,n,t) (MEM_WRAP_CHECK(n,t), (void)memzero((char*)(d), (n) * sizeof(t))) +#define MoveD(s,d,n,t) (MEM_WRAP_CHECK(n,t), memmove((char*)(d),(char*)(s), (n) * sizeof(t))) +#define CopyD(s,d,n,t) (MEM_WRAP_CHECK(n,t), memcpy((char*)(d),(char*)(s), (n) * sizeof(t))) +#ifdef HAS_MEMSET +#define ZeroD(d,n,t) (MEM_WRAP_CHECK(n,t), memzero((char*)(d), (n) * sizeof(t))) +#else +/* Using bzero(), which returns void. */ +#define ZeroD(d,n,t) (MEM_WRAP_CHECK(n,t), memzero((char*)(d), (n) * sizeof(t)),d) +#endif + #define Poison(d,n,t) (MEM_WRAP_CHECK(n,t), (void)memset((char*)(d), 0xAB, (n) * sizeof(t))) #else @@ -627,6 +650,14 @@ hopefully catches attempts to access uninitialized memory. #define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) #define Zero(d,n,t) (void)memzero((char*)(d), (n) * sizeof(t)) +#define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t)) +#define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) +#ifdef HAS_MEMSET +#define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t)) +#else +#define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)),d) +#endif + #define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t)) #endif @@ -640,6 +671,9 @@ hopefully catches attempts to access uninitialized memory. #define Move(s,d,n,t) #define Copy(s,d,n,t) #define Zero(d,n,t) +#define MoveD(s,d,n,t) d +#define CopyD(s,d,n,t) d +#define ZeroD(d,n,t) d #define Poison(d,n,t) #define Safefree(d) (d) = (d) diff --git a/gnu/usr.bin/perl/hints/aix.sh b/gnu/usr.bin/perl/hints/aix.sh index e4966042bc8..852059d813e 100644 --- a/gnu/usr.bin/perl/hints/aix.sh +++ b/gnu/usr.bin/perl/hints/aix.sh @@ -157,7 +157,11 @@ case "$cc" in # -bI:$(PERL_INC)/perl.exp Read the exported symbols from the perl binary # -bE:$(BASEEXT).exp Export these symbols. This file contains only one # symbol: boot_$(EXP) can it be auto-generated? -lddlflags="$lddlflags -bhalt:4 -bM:SRE -bI:\$(PERL_INC)/perl.exp -bE:\$(BASEEXT).exp -bnoentry -lc" +if test $usenativedlopen = 'true' ; then + lddlflags="$lddlflags -bhalt:4 -bexpall -G -bnoentry -lc" +else + lddlflags="$lddlflags -bhalt:4 -bM:SRE -bI:\$(PERL_INC)/perl.exp -bE:\$(BASEEXT).exp -bnoentry -lc" + fi case "$use64bitall" in $define|true|[yY]*) use64bitint="$define" ;; @@ -314,7 +318,11 @@ libswanted_uselargefiles="`getconf XBS5_ILP32_OFFBIG_LIBS 2>/dev/null|sed -e 's@ ccflags="`echo $ccflags | sed -e 's@ -b@ -Wl,-b@g'`" ldflags="`echo ' '$ldflags | sed -e 's@ -b@ -Wl,-b@g'`" lddlflags="`echo ' '$lddlflags | sed -e 's@ -b@ -Wl,-b@g'`" - ld='gcc' + lddlflags="`echo ' '$lddlflags | sed -e 's@ -G @ -Wl,-G @g'`" + case "$use64bitall" in + $define|true|[yY]*) ld="gcc -maix64" ;; + *) ld="gcc" ;; + esac echo >&4 "(using ccflags $ccflags)" echo >&4 "(using ldflags $ldflags)" echo >&4 "(using lddlflags $lddlflags)" @@ -379,6 +387,13 @@ EOM # Remove them. ccflags="`echo $ccflags | sed -e 's@-q32@@'`" ldflags="`echo $ldflags | sed -e 's@-b32@@'`" + case "$cc" in + *gcc*) + ccflags="`echo $ccflags | sed -e 's@-q64@-maix64@'`" + ccflags_uselargefiles="`echo $ccflags_uselargefiles | sed -e 's@-q64@-maix64@'`" + qacflags="`echo $qacflags | sed -e 's@-q64@-maix64@'`" + ;; + esac # Tell archiver to use large format. Unless we remove 'ar' # from 'trylist', the Configure script will just reset it to 'ar' # immediately prior to writing config.sh. This took me hours @@ -415,9 +430,19 @@ EOCBU if test $usenativedlopen = 'true' ; then ccflags="$ccflags -DUSE_NATIVE_DLOPEN" + # -brtl Enables a binary to use run time linking + # -bdynamic When used with -brtl, tells linker to search for + # ".so"-suffix libraries as well as ".a" suffix + # libraries. AIX allows both .so and .a libraries to + # contain dynamic shared objects. + # -bmaxdata:0x80000000 This increases the size of heap memory available + # to perl. Default is 256 MB, which sounds large but + # caused a software vendor problems. So this sets + # heap to 2 GB maximum. Anything higher and you'd + # want to consider 64 bit perl. case "$cc" in - *gcc*) ldflags="$ldflags -Wl,-brtl" ;; - *) ldflags="$ldflags -brtl" ;; + *gcc*) ldflags="$ldflags -Wl,-brtl -Wl,-bdynamic -Wl,-bmaxdata:0x80000000" ;; + *) ldflags="$ldflags -brtl -bdynamic -bmaxdata:0x80000000" ;; esac elif test -f /lib/libC.a -a X"`$cc -v 2>&1 | grep gcc`" = X; then # If the C++ libraries, libC and libC_r, are available we will diff --git a/gnu/usr.bin/perl/hints/irix_6.sh b/gnu/usr.bin/perl/hints/irix_6.sh index ad6e7788ece..b09e34dfca5 100644 --- a/gnu/usr.bin/perl/hints/irix_6.sh +++ b/gnu/usr.bin/perl/hints/irix_6.sh @@ -41,6 +41,9 @@ # The compiler bug has been reported to SGI. # -- Allen Smith <allens@cpan.org> +# Modified (10/30/04) to turn off usemallocwrap (PERL_MALLOC_WRAP) in -n32 +# mode - Allen. + case "$use64bitall" in $define|true|[yY]*) case "`uname -s`" in @@ -140,7 +143,15 @@ esac' test -z "$lddlflags" && lddlflags="-n32 -shared" test -z "$libc" && libc='/usr/lib32/libc.so' test -z "$plibpth" && plibpth='/usr/lib32 /lib32 /usr/ccs/lib' - ;; + + # PERL_MALLOC_WRAP gives false alarms ("panic: memory wrap") in IRIX + # -n32 mode, resulting in perl compiles never getting further than + # miniperl. I am not sure whether it actually does any good in -32 or + # -64 mode, especially the latter, but it does not give false + # alarms (in testing). -Allen + + usemallocwrap=${usemallocwrap:-false} + ;; *"cc -64"*) case "`uname -s`" in IRIX) @@ -188,6 +199,8 @@ esac' lddlflags="$lddlflags -mabi=64" ;; *) ccflags="$ccflags -DIRIX32_SEMUN_BROKEN_BY_GCC" + # XXX Note: It is possible that turning off usemallocwrap is + # needed here; insufficient data! - Allen ;; esac ;; diff --git a/gnu/usr.bin/perl/hints/openbsd.sh b/gnu/usr.bin/perl/hints/openbsd.sh index 9c3e0934c93..9257ac37668 100644 --- a/gnu/usr.bin/perl/hints/openbsd.sh +++ b/gnu/usr.bin/perl/hints/openbsd.sh @@ -122,7 +122,7 @@ $define|true|[yY]*) esac case "$osvers" in [012].*|3.[0-5]) - # Broken at least up to OpenBSD 3.5, we'll see about 3.6 + # Broken up to OpenBSD 3.6, fixed in OpenBSD 3.7 d_getservbyname_r=$undef ;; esac esac diff --git a/gnu/usr.bin/perl/hv.c b/gnu/usr.bin/perl/hv.c index 0632ab1561b..ec62eb74eb8 100644 --- a/gnu/usr.bin/perl/hv.c +++ b/gnu/usr.bin/perl/hv.c @@ -14,6 +14,16 @@ /* =head1 Hash Manipulation Functions + +A HV structure represents a Perl hash. It consists mainly of an array +of pointers, each of which points to a linked list of HE structures. The +array is indexed by the hash function of the key, so each linked list +represents all the hash entries with the same hash value. Each HE contains +a pointer to the actual value, plus a pointer to a HEK structure which +holds the key and hash value. + +=cut + */ #include "EXTERN.h" @@ -218,7 +228,7 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash) flags = 0; } hek = hv_fetch_common (hv, NULL, key, klen, flags, - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, 0); + (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); return hek ? &HeVAL(hek) : NULL; } @@ -505,6 +515,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, key = (const char*)strupr((char*)key); is_utf8 = 0; hash = 0; + keysv = 0; if (flags & HVhek_FREEKEY) { Safefree(keysave); @@ -547,6 +558,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, key = (const char*)strupr((char*)key); is_utf8 = 0; hash = 0; + keysv = 0; if (flags & HVhek_FREEKEY) { Safefree(keysave); @@ -1490,7 +1502,7 @@ Clears any placeholders from a hash. If a restricted hash has any of its keys marked as readonly and the key is subsequently deleted, the key is not actually deleted but is marked by assigning it a value of &PL_sv_placeholder. This tags it so it will be ignored by future operations such as iterating over the hash, -but will still allow the hash to have a value reaasigned to the key at some +but will still allow the hash to have a value reassigned to the key at some future point. This function clears any such placeholder keys from the hash. See Hash::Util::lock_keys() for an example of its use. diff --git a/gnu/usr.bin/perl/lib/Carp.pm b/gnu/usr.bin/perl/lib/Carp.pm index 22f7daf9418..86f0d921ee2 100644 --- a/gnu/usr.bin/perl/lib/Carp.pm +++ b/gnu/usr.bin/perl/lib/Carp.pm @@ -39,6 +39,10 @@ croak or shortmess which report the error as being from where your module was called. There is no guarantee that that is where the error was, but it is a good educated guess. +You can also alter the way the output and logic of C<Carp> works, by +changing some global variables in the C<Carp> namespace. See the +section on C<GLOBAL VARIABLES> below. + Here is a more complete description of how shortmess works. What it does is search the call-stack for a function call stack where it hasn't been told that there shouldn't be an error. If every @@ -51,7 +55,7 @@ a call shouldn't generate errors work as follows: =item 1. -Any call from a package to itself is safe. +Any call from a package to itself is safe. =item 2. @@ -95,11 +99,8 @@ This feature is enabled by 'importing' the non-existent symbol or by including the string C<MCarp=verbose> in the PERL5OPT environment variable. -=head1 BUGS - -The Carp routines don't handle exception objects currently. -If called with a first argument that is a reference, they simply -call die() or warn(), as appropriate. +Alternately, you can set the global variable C<$Carp::Verbose> to true. +See the C<GLOBAL VARIABLES> section below. =cut @@ -118,16 +119,76 @@ call die() or warn(), as appropriate. # $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval # text and function arguments should be formatted when printed. +# Comments added by Jos I. Boumans <kane@dwim.org> 11-Aug-2004 +# I can not get %CarpInternal or %Internal to work as advertised, +# therefor leaving it out of the below documentation. +# $CarpLevel may be decprecated according to the last comment, but +# after 6 years, it's still around and in heavy use ;) + +=pod + +=head1 GLOBAL VARIABLES + +=head2 $Carp::CarpLevel + +This variable determines how many call frames are to be skipped when +reporting where an error occurred on a call to one of C<Carp>'s +functions. For example: + + $Carp::CarpLevel = 1; + sub bar { .... or _error('Wrong input') } + sub _error { Carp::carp(@_) } + +This would make Carp report the error as coming from C<bar>'s caller, +rather than from C<_error>'s caller, as it normally would. + +Defaults to C<0>. + +=head2 $Carp::MaxEvalLen + +This variable determines how many characters of a string-eval are to +be shown in the output. Use a value of C<0> to show all text. + +Defaults to C<0>. + +=head2 $Carp::MaxArgLen + +This variable determines how many characters of each argument to a +function to print. Use a value of C<0> to show the full length of the +argument. + +Defaults to C<64>. + +=head2 $Carp::MaxArgNums + +This variable determines how many arguments to each function to show. +Use a value of C<0> to show all arguments to a function call. + +Defaults to C<8>. + +=head2 $Carp::Verbose + +This variable makes C<Carp> use the C<longmess> function at all times. +This effectively means that all calls to C<carp> become C<cluck> and +all calls to C<croak> become C<confess>. + +Note, this is analogous to using C<use Carp 'verbose'>. + +Defaults to C<0>. + +=cut + + $CarpInternal{Carp}++; $CarpInternal{warnings}++; -$CarpLevel = 0; # How many extra package levels to skip on carp. - # How many calls to skip on confess. - # Reconciling these notions is hard, use - # %Internal and %CarpInternal instead. -$MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all. -$MaxArgLen = 64; # How much of each argument to print. 0 = all. -$MaxArgNums = 8; # How many arguments to print. 0 = all. -$Verbose = 0; # If true then make shortmess call longmess instead +$CarpLevel = 0; # How many extra package levels to skip on carp. + # How many calls to skip on confess. + # Reconciling these notions is hard, use + # %Internal and %CarpInternal instead. +$MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all. +$MaxArgLen = 64; # How much of each argument to print. 0 = all. +$MaxArgNums = 8; # How many arguments to print. 0 = all. +$Verbose = 0; # If true then make shortmess call longmess instead require Exporter; @ISA = ('Exporter'); @@ -135,6 +196,13 @@ require Exporter; @EXPORT_OK = qw(cluck verbose longmess shortmess); @EXPORT_FAIL = qw(verbose); # hook to enable verbose mode +=head1 BUGS + +The Carp routines don't handle exception objects currently. +If called with a first argument that is a reference, they simply +call die() or warn(), as appropriate. + +=cut # if the caller specifies verbose usage ("perl -MCarp=verbose script.pl") # then the following method will be called by the Exporter which knows diff --git a/gnu/usr.bin/perl/lib/Cwd.pm b/gnu/usr.bin/perl/lib/Cwd.pm index b0dad20e6ac..febd296bd30 100644 --- a/gnu/usr.bin/perl/lib/Cwd.pm +++ b/gnu/usr.bin/perl/lib/Cwd.pm @@ -1,5 +1,5 @@ package Cwd; -$VERSION = $VERSION = '2.19'; +$VERSION = $VERSION = '3.01'; =head1 NAME @@ -469,7 +469,8 @@ sub _perl_abs_path(;$) my ($dir, $file) = $start =~ m{^(.*)/(.+)$} or return cwd() . '/' . $start; - if (-l _) { + # Can't use "-l _" here, because the previous stat was a stat(), not an lstat(). + if (-l $start) { my $link_target = readlink($start); die "Can't resolve link $start: $!" unless defined $link_target; diff --git a/gnu/usr.bin/perl/lib/Math/BigInt.pm b/gnu/usr.bin/perl/lib/Math/BigInt.pm index 7393b12d24b..541753581fb 100644 --- a/gnu/usr.bin/perl/lib/Math/BigInt.pm +++ b/gnu/usr.bin/perl/lib/Math/BigInt.pm @@ -18,7 +18,7 @@ package Math::BigInt; my $class = "Math::BigInt"; require 5.005; -$VERSION = '1.70'; +$VERSION = '1.73'; use Exporter; @ISA = qw( Exporter ); @EXPORT_OK = qw( objectify bgcd blcm); @@ -55,6 +55,9 @@ use overload '|=' => sub { $_[0]->bior($_[1]); }, '**=' => sub { $_[0]->bpow($_[1]); }, +'<<=' => sub { $_[0]->blsft($_[1]); }, +'>>=' => sub { $_[0]->brsft($_[1]); }, + # not supported by Perl yet '..' => \&_pointpoint, @@ -79,9 +82,9 @@ use overload 'sqrt' => sub { $_[0]->copy()->bsqrt(); }, '~' => sub { $_[0]->copy()->bnot(); }, -# for sub it is a bit tricky to keep b: b-a => -a+b +# for subtract it's a bit tricky to not modify b: b-a => -a+b '-' => sub { my $c = $_[0]->copy; $_[2] ? - $c->bneg()->badd($_[1]) : + $c->bneg()->badd( $_[1]) : $c->bsub( $_[1]) }, '+' => sub { $_[0]->copy()->badd($_[1]); }, '*' => sub { $_[0]->copy()->bmul($_[1]); }, @@ -667,7 +670,7 @@ sub bzero { # create a bigint '+0', if given a BigInt, set it to 0 my $self = shift; - $self = $class if !defined $self; + $self = __PACKAGE__ if !defined $self; if (!ref($self)) { @@ -758,7 +761,7 @@ sub bsstr # (ref to BFLOAT or num_str ) return num_str # Convert number from internal format to scientific string format. # internal format is always normalized (no leading zeros, "-0E0" => "+0E0") - my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x); + my $x = shift; my $class = ref($x) || $x; $x = $class->new(shift) if !ref($x); # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); if ($x->{sign} !~ /^[+-]$/) @@ -775,7 +778,7 @@ sub bsstr sub bstr { # make a string from bigint object - my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x); + my $x = shift; my $class = ref($x) || $x; $x = $class->new(shift) if !ref($x); # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); if ($x->{sign} !~ /^[+-]$/) @@ -889,7 +892,8 @@ sub round # $r round_mode, if given by caller # @args all 'other' arguments (0 for unary, 1 for binary ops) - # leave bigfloat parts alone + # leave bigfloat parts alone (that is only used in BigRat for now and can be + # removed once we rewrote BigRat)) return ($self) if exists $self->{_f} && ($self->{_f} & MB_NEVER_ROUND) != 0; my $c = ref($self); # find out class of argument(s) @@ -942,7 +946,8 @@ sub round { $self->bfround($p,$r) if !defined $self->{_p} || $self->{_p} <= $p; } - $self->bnorm(); # after round, normalize + # bround() or bfround() already callled bnorm() if necc. + $self; } sub bnorm @@ -1140,6 +1145,14 @@ sub bsub return $x; } + require Scalar::Util; + if (Scalar::Util::refaddr($x) == Scalar::Util::refaddr($y)) + { + # if we get the same variable twice, the result must be zero (the code + # below fails in that case) + return $x->bzero(@r) if $x->{sign} =~ /^[+-]$/; + return $x->bnan(); # NaN, -inf, +inf + } $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN $x->badd($y,@r); # badd does not leave internal zeros $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN) @@ -1240,7 +1253,7 @@ sub blcm } else { - $x = __PACKAGE__->new($y); + $x = $class->new($y); } my $self = ref($x); while (@_) @@ -1258,7 +1271,7 @@ sub bgcd # GCD -- Euclids algorithm, variant C (Knuth Vol 3, pg 341 ff) my $y = shift; - $y = __PACKAGE__->new($y) if !ref($y); + $y = $class->new($y) if !ref($y); my $self = ref($y); my $x = $y->copy()->babs(); # keep arguments return $x->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN? @@ -1662,12 +1675,61 @@ sub bpow return $x if $x->modify('bpow'); + return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; + + # inf handling + if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) + { + if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) + { + # +-inf ** +-inf + return $x->bnan(); + } + # +-inf ** Y + if ($x->{sign} =~ /^[+-]inf/) + { + # +inf ** 0 => NaN + return $x->bnan() if $y->is_zero(); + # -inf ** -1 => 1/inf => 0 + return $x->bzero() if $y->is_one('-') && $x->is_negative(); + + # +inf ** Y => inf + return $x if $x->{sign} eq '+inf'; + + # -inf ** Y => -inf if Y is odd + return $x if $y->is_odd(); + return $x->babs(); + } + # X ** +-inf + + # 1 ** +inf => 1 + return $x if $x->is_one(); + + # 0 ** inf => 0 + return $x if $x->is_zero() && $y->{sign} =~ /^[+]/; + + # 0 ** -inf => inf + return $x->binf() if $x->is_zero(); + + # -1 ** -inf => NaN + return $x->bnan() if $x->is_one('-') && $y->{sign} =~ /^[-]/; + + # -X ** -inf => 0 + return $x->bzero() if $x->{sign} eq '-' && $y->{sign} =~ /^[-]/; + + # -1 ** inf => NaN + return $x->bnan() if $x->{sign} eq '-'; + + # X ** inf => inf + return $x->binf() if $y->{sign} =~ /^[+]/; + # X ** -inf => 0 + return $x->bzero(); + } + return $upgrade->bpow($upgrade->new($x),$y,@r) if defined $upgrade && !$y->isa($self); $r[3] = $y; # no push! - return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x - return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu @@ -2027,17 +2089,15 @@ sub bfround sub _scan_for_nonzero { - # internal, used by bround() - my ($x,$pad,$xs) = @_; + # internal, used by bround() to scan for non-zeros after a '5' + my ($x,$pad,$xs,$len) = @_; - my $len = $x->length(); - return 0 if $len == 1; # '5' is trailed by invisible zeros + return 0 if $len == 1; # "5" is trailed by invisible zeros my $follow = $pad - 1; return 0 if $follow > $len || $follow < 1; - # since we do not know underlying represention of $x, use decimal string - my $r = substr ("$x",-$follow); - $r =~ /[^0]/ ? 1 : 0; + # use the string form to check whether only '0's follow or not + substr ($xs,-$follow) =~ /[^0]/ ? 1 : 0; } sub fround @@ -2087,8 +2147,8 @@ sub bround $pad = $len - $scale; $pad = abs($scale-1) if $scale < 0; - # do not use digit(), it is costly for binary => decimal - + # do not use digit(), it is very costly for binary => decimal + # getting the entire string is also costly, but we need to do it only once my $xs = $CALC->_str($x->{value}); my $pl = -$pad-1; @@ -2106,7 +2166,7 @@ sub bround ($digit_after =~ /[01234]/) || # round down anyway, # 6789 => round up ($digit_after eq '5') && # not 5000...0000 - ($x->_scan_for_nonzero($pad,$xs) == 0) && + ($x->_scan_for_nonzero($pad,$xs,$len) == 0) && ( ($mode eq 'even') && ($digit_round =~ /[24680]/) || ($mode eq 'odd') && ($digit_round =~ /[13579]/) || @@ -2118,8 +2178,8 @@ sub bround if (($pad > 0) && ($pad <= $len)) { - substr($xs,-$pad,$pad) = '0' x $pad; - $put_back = 1; + substr($xs,-$pad,$pad) = '0' x $pad; # replace with '00...' + $put_back = 1; # need to put back } elsif ($pad > $len) { @@ -2128,7 +2188,7 @@ sub bround if ($round_up) # what gave test above? { - $put_back = 1; + $put_back = 1; # need to put back $pad = $len, $xs = '0' x $pad if $scale < 0; # tlr: whack 0.51=>1.0 # we modify directly the string variant instead of creating a number and @@ -2143,7 +2203,7 @@ sub bround $xs = '1'.$xs if $c == 0; } - $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back in if needed + $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back, if needed $x->{_a} = $scale if $scale >= 0; if ($scale < 0) diff --git a/gnu/usr.bin/perl/lib/Text/ParseWords.pm b/gnu/usr.bin/perl/lib/Text/ParseWords.pm index fbc0ee038f9..94e6db7bcf9 100644 --- a/gnu/usr.bin/perl/lib/Text/ParseWords.pm +++ b/gnu/usr.bin/perl/lib/Text/ParseWords.pm @@ -1,7 +1,7 @@ package Text::ParseWords; use vars qw($VERSION @ISA @EXPORT $PERL_SINGLE_QUOTE); -$VERSION = "3.22"; +$VERSION = "3.23"; require 5.000; @@ -53,32 +53,27 @@ sub parse_line { use re 'taint'; # if it's tainted, leave it as such my($delimiter, $keep, $line) = @_; - my($quote, $quoted, $unquoted, $delim, $word, @pieces); + my($word, @pieces); while (length($line)) { - - ($quote, $quoted, undef, $unquoted, $delim, undef) = - $line =~ m/^(["']) # a $quote - ((?:\\[\000-\377]|(?!\1)[^\\])*) # and $quoted text - \1 # followed by the same quote - ([\000-\377]*) # and the rest - | # --OR-- - ^((?:\\[\000-\377]|[^\\"'])*?) # an $unquoted text - (\Z(?!\n)|(?-x:$delimiter)|(?!^)(?=["'])) - # plus EOL, delimiter, or quote - ([\000-\377]*) # the rest - /x; # extended layout - return() unless( $quote || length($unquoted) || length($delim)); - - $line = $+; + $line =~ s/^(["']) # a $quote + ((?:\\.|(?!\1)[^\\])*) # and $quoted text + \1 # followed by the same quote + | # --OR-- + ^((?:\\.|[^\\"'])*?) # an $unquoted text + (\Z(?!\n)|(?-x:$delimiter)|(?!^)(?=["'])) + # plus EOL, delimiter, or quote + //xs or return; # extended layout + my($quote, $quoted, $unquoted, $delim) = ($1, $2, $3, $4); + return() unless( defined($quote) || length($unquoted) || length($delim)); if ($keep) { $quoted = "$quote$quoted$quote"; } else { - $unquoted =~ s/\\([\000-\377])/$1/g; + $unquoted =~ s/\\(.)/$1/sg; if (defined $quote) { - $quoted =~ s/\\([\000-\377])/$1/g if ($quote eq '"'); + $quoted =~ s/\\(.)/$1/sg if ($quote eq '"'); $quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'"); } } diff --git a/gnu/usr.bin/perl/lib/base.pm b/gnu/usr.bin/perl/lib/base.pm index e98d0f1e61b..832b6a4a9a1 100644 --- a/gnu/usr.bin/perl/lib/base.pm +++ b/gnu/usr.bin/perl/lib/base.pm @@ -152,10 +152,9 @@ sub inherit_fields { } } - unless( keys %$bfields ) { - foreach my $idx (1..$#{$battr}) { - $dattr->[$idx] = $battr->[$idx] & INHERITED; - } + foreach my $idx (1..$#{$battr}) { + next if defined $dattr->[$idx]; + $dattr->[$idx] = $battr->[$idx] & INHERITED; } } diff --git a/gnu/usr.bin/perl/lib/diagnostics.pm b/gnu/usr.bin/perl/lib/diagnostics.pm index ec58bb19a91..a1910359b41 100644 --- a/gnu/usr.bin/perl/lib/diagnostics.pm +++ b/gnu/usr.bin/perl/lib/diagnostics.pm @@ -19,12 +19,17 @@ Using the C<splain> standalone filter program: perl program 2>diag.out splain [-v] [-p] diag.out +Using diagnostics to get stack traces from a misbehaving script: + + perl -Mdiagnostics=-traceonly my_script.pl + =head1 DESCRIPTION =head2 The C<diagnostics> Pragma This module extends the terse diagnostics normally emitted by both the -perl compiler and the perl interpreter, augmenting them with the more +perl compiler and the perl interpreter (from running perl with a -w +switch or C<use warnings>), augmenting them with the more explicative and endearing descriptions found in L<perldiag>. Like the other pragmata, it affects the compilation phase of your program rather than merely the execution phase. @@ -53,6 +58,17 @@ descriptions found in L<perldiag>) are only displayed once (no duplicate descriptions). User code generated warnings a la warn() are unaffected, allowing duplicate user messages to be displayed. +This module also adds a stack trace to the error message when perl dies. +This is useful for pinpointing what caused the death. The B<-traceonly> (or +just B<-t>) flag turns off the explantions of warning messages leaving just +the stack traces. So if your script is dieing, run it again with + + perl -Mdiagnostics=-traceonly my_bad_script + +to see the call stack at the time of death. By supplying the B<-warntrace> +(or just B<-w>) flag, any warnings emitted will also come with a stack +trace. + =head2 The I<splain> Program While apparently a whole nuther program, I<splain> is actually nothing @@ -167,11 +183,14 @@ Tom Christiansen <F<tchrist@mox.perl.com>>, 25 June 1995. use strict; use 5.006; use Carp; +$Carp::Internal{__PACKAGE__.""}++; -our $VERSION = 1.13; +our $VERSION = 1.14; our $DEBUG; our $VERBOSE; our $PRETTY; +our $TRACEONLY = 0; +our $WARNTRACE = 0; use Config; my($privlib, $archlib) = @Config{qw(privlibexp archlibexp)}; @@ -448,6 +467,15 @@ sub import { next; }; + /^-t(race)?$/ && do { + $TRACEONLY++; + next; + }; + /^-w(arntrace)?$/ && do { + $WARNTRACE++; + next; + }; + warn "Unknown flag: $_"; } @@ -469,9 +497,13 @@ sub disable { sub warn_trap { my $warning = $_[0]; if (caller eq $WHOAMI or !splainthis($warning)) { - print STDERR $warning; + if ($WARNTRACE) { + print STDERR Carp::longmess($warning); + } else { + print STDERR $warning; + } } - &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap; + goto &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap; }; sub death_trap { @@ -481,8 +513,7 @@ sub death_trap { # want to explain the exception because it's going to get caught. my $in_eval = 0; my $i = 0; - while (1) { - my $caller = (caller($i++))[3] or last; + while (my $caller = (caller($i++))[3]) { if ($caller eq '(eval)') { $in_eval = 1; last; @@ -516,6 +547,7 @@ my %old_diag; my $count; my $wantspace; sub splainthis { + return 0 if $TRACEONLY; local $_ = shift; local $\; ### &finish_compilation unless %msg; diff --git a/gnu/usr.bin/perl/lib/overload.pm b/gnu/usr.bin/perl/lib/overload.pm index 6fc69d60672..577c3878ecc 100644 --- a/gnu/usr.bin/perl/lib/overload.pm +++ b/gnu/usr.bin/perl/lib/overload.pm @@ -1,6 +1,6 @@ package overload; -our $VERSION = '1.01'; +our $VERSION = '1.02'; $overload::hint_bits = 0x20000; # HINT_LOCALIZE_HH @@ -704,7 +704,10 @@ Package C<overload.pm> provides the following public functions: =item overload::StrVal(arg) -Gives string value of C<arg> as in absence of stringify overloading. +Gives string value of C<arg> as in absence of stringify overloading. If you +are using this to get the address of a reference (useful for checking if two +references point to the same thing) then you may be better off using +C<Scalar::Util::refaddr()>, which is faster. =item overload::Overloaded(arg) diff --git a/gnu/usr.bin/perl/lib/perl5db.pl b/gnu/usr.bin/perl/lib/perl5db.pl index 37642e7a5b6..a45a5720c20 100644 --- a/gnu/usr.bin/perl/lib/perl5db.pl +++ b/gnu/usr.bin/perl/lib/perl5db.pl @@ -1,7 +1,7 @@ =head1 NAME -C<perl5db.pl> - the perl debugger +perl5db.pl - the perl debugger =head1 SYNOPSIS @@ -40,7 +40,7 @@ Unfortunately, though the variables are accessible, they're not well documented, so it's generally been a decision that hasn't made a lot of difference to most users. Where appropriate, comments have been added to make variables more accessible and usable, with the understanding that these -i<are> debugger internals, and are therefore subject to change. Future +I<are> debugger internals, and are therefore subject to change. Future development should probably attempt to replace the globals with a well-defined API, but for now, the variables are what we've got. @@ -104,7 +104,7 @@ Boolean algebra states that the truth table for XOR looks like this: =back As you can see, the first pair applies when C<!> isn't supplied, and -the second pair applies when it isn't. The XOR simply allows us to +the second pair applies when it is. The XOR simply allows us to compact a more complicated if-then-elseif-else into a more elegant (but perhaps overly clever) single test. After all, it needed this explanation... @@ -112,7 +112,7 @@ explanation... =head2 FLAGS, FLAGS, FLAGS There is a certain C programming legacy in the debugger. Some variables, -such as C<$single>, C<$trace>, and C<$frame>, have "magical" values composed +such as C<$single>, C<$trace>, and C<$frame>, have I<magical> values composed of 1, 2, 4, etc. (powers of 2) OR'ed together. This allows several pieces of state to be stored independently in a single scalar. @@ -132,22 +132,27 @@ it? =over 4 +=item * -=item * First, doing an arithmetical or bitwise operation on a scalar is +First, doing an arithmetical or bitwise operation on a scalar is just about the fastest thing you can do in Perl: C<use constant> actually -creates a subroutine call, and array hand hash lookups are much slower. Is +creates a subroutine call, and array and hash lookups are much slower. Is this over-optimization at the expense of readability? Possibly, but the debugger accesses these variables a I<lot>. Any rewrite of the code will probably have to benchmark alternate implementations and see which is the best balance of readability and speed, and then document how it actually works. -=item * Second, it's very easy to serialize a scalar number. This is done in +=item * + +Second, it's very easy to serialize a scalar number. This is done in the restart code; the debugger state variables are saved in C<%ENV> and then restored when the debugger is restarted. Having them be just numbers makes this trivial. -=item * Third, some of these variables are being shared with the Perl core +=item * + +Third, some of these variables are being shared with the Perl core smack in the middle of the interpreter's execution loop. It's much faster for a C program (like the interpreter) to check a bit in a scalar than to access several different variables (or a Perl array). @@ -176,10 +181,13 @@ The hash C<%{'_<'.$filename}> (aliased locally to C<%dbline> via glob assignment) contains breakpoints and actions. The keys are line numbers; you can set individual values, but not the whole hash. The Perl interpreter uses this hash to determine where breakpoints have been set. Any true value is -considered to be a breakpoint; C<perl5db.pl> uses "$break_condition\0$action". +considered to be a breakpoint; C<perl5db.pl> uses C<$break_condition\0$action>. Values are magical in numeric context: 1 if the line is breakable, 0 if not. -The scalar ${'_<'.$filename} contains $filename XXX What? +The scalar C<${"_<$filename"}> simply contains the string C<_<$filename>. +This is also the case for evaluated strings that contain subroutines, or +which are currently being executed. The $filename for C<eval>ed strings looks +like C<(eval 34)> or C<(re_eval 19)>. =head1 DEBUGGER STARTUP @@ -190,7 +198,7 @@ that will be executed (in the debugger's context) after the debugger has initialized itself. Next, it checks the C<PERLDB_OPTS> environment variable and treats its -contents as the argument of a debugger <C<o> command. +contents as the argument of a C<o> command in the debugger. =head2 STARTUP-ONLY OPTIONS @@ -207,7 +215,7 @@ the TTY to use for debugging i/o. =item * noTTY if set, goes in NonStop mode. On interrupt, if TTY is not set, -uses the value of noTTY or "/tmp/perldbtty$$" to find TTY using +uses the value of noTTY or F</tmp/perldbtty$$> to find TTY using Term::Rendezvous. Current variant is to have the name of TTY in this file. @@ -238,14 +246,14 @@ host:port to connect to on remote host for remote debugging. The script will run without human intervention, putting trace information into C<db.out>. (If you interrupt it, you had better -reset C<LineInfo> to something "interactive"!) +reset C<LineInfo> to something I<interactive>!) =head1 INTERNALS DESCRIPTION =head2 DEBUGGER INTERFACE VARIABLES Perl supplies the values for C<%sub>. It effectively inserts -a C<&DB'DB();> in front of each place that can have a +a C<&DB::DB();> in front of each place that can have a breakpoint. At each subroutine call, it calls C<&DB::sub> with C<$DB::sub> set to the called subroutine. It also inserts a C<BEGIN {require 'perl5db.pl'}> before the first line. @@ -290,11 +298,11 @@ is entered or exited. =item * 0 - No enter/exit messages -=item * 1 - Print "entering" messages on subroutine entry +=item * 1 - Print I<entering> messages on subroutine entry =item * 2 - Adds exit messages on subroutine exit. If no other flag is on, acts like 1+2. -=item * 4 - Extended messages: C<in|out> I<context>=I<fully-qualified sub name> from I<file>:I<line>>. If no other flag is on, acts like 1+4. +=item * 4 - Extended messages: C<< <in|out> I<context>=I<fully-qualified sub name> from I<file>:I<line> >>. If no other flag is on, acts like 1+4. =item * 8 - Adds parameter information to messages, and overloaded stringify and tied FETCH is enabled on the printed arguments. Ignored if C<4> is not on. @@ -302,7 +310,7 @@ is entered or exited. =back -To get everything, use C<$frame=30> (or C<o f-30> as a debugger command). +To get everything, use C<$frame=30> (or C<o f=30> as a debugger command). The debugger internally juggles the value of C<$frame> during execution to protect external modules that the debugger uses from getting traced. @@ -330,7 +338,7 @@ expression. =head4 C<$onetimeDumpDepth> -Controls how far down C<dumpvar.pl> will go before printing '...' while +Controls how far down C<dumpvar.pl> will go before printing C<...> while dumping a structure. Numeric. If C<undef>, print all levels. =head4 C<$signal> @@ -348,12 +356,12 @@ each subroutine; popped again at the end of each subroutine. =item * 0 - run continuously. -=item * 1 - single-step, go into subs. The 's' command. +=item * 1 - single-step, go into subs. The C<s> command. -=item * 2 - single-step, don't go into subs. The 'n' command. +=item * 2 - single-step, don't go into subs. The C<n> command. -=item * 4 - print current sub depth (turned on to force this when "too much -recursion" occurs. +=item * 4 - print current sub depth (turned on to force this when C<too much +recursion> occurs. =back @@ -422,7 +430,7 @@ Keys are file names, values are 1 (break when this file is loaded) or undef =head4 C<%dbline> -Keys are line numbers, values are "condition\0action". If used in numeric +Keys are line numbers, values are C<condition\0action>. If used in numeric context, values are 0 if not breakable, 1 if breakable, no matter what is in the actual hash entry. @@ -451,9 +459,9 @@ Keys are subroutine names, values are: =over 4 -=item * 'compile' - break when this sub is compiled +=item * C<compile> - break when this sub is compiled -=item * 'break +0 if <condition>' - break (conditionally) at the start of this routine. The condition will be '1' if no condition was specified. +=item * C<< break +0 if <condition> >> - break (conditionally) at the start of this routine. The condition will be '1' if no condition was specified. =back @@ -462,7 +470,7 @@ Keys are subroutine names, values are: This hash keeps track of breakpoints that need to be set for files that have not yet been compiled. Keys are filenames; values are references to hashes. Each of these hashes is keyed by line number, and its values are breakpoint -definitions ("condition\0action"). +definitions (C<condition\0action>). =head1 DEBUGGER INITIALIZATION @@ -493,7 +501,7 @@ package DB; use IO::Handle; # Debugger for Perl 5.00x; perl5db.pl patch level: -$VERSION = 1.27; +$VERSION = 1.28; $header = "perl5db.pl version $VERSION"; @@ -507,20 +515,20 @@ the process of evaluating code in the user's context. The code to be evaluated is passed via the package global variable C<$DB::evalarg>; this is done to avoid fiddling with the contents of C<@_>. -We preserve the current settings of X<C<$trace>>, X<C<$single>>, and X<C<$^D>>; -add the X<C<$usercontext>> (that's the preserved values of C<$@>, C<$!>, -C<$^E>, C<$,>, C<$/>, C<$\>, and C<$^W>, grabbed when C<DB::DB> got control, -and the user's current package) and a add a newline before we do the C<eval()>. -This causes the proper context to be used when the eval is actually done. -Afterward, we restore C<$trace>, C<$single>, and C<$^D>. +Before we do the C<eval()>, we preserve the current settings of C<$trace>, +C<$single>, C<$^D> and C<$usercontext>. The latter contains the +preserved values of C<$@>, C<$!>, C<$^E>, C<$,>, C<$/>, C<$\>, C<$^W> and the +user's current package, grabbed when C<DB::DB> got control. This causes the +proper context to be used when the eval is actually done. Afterward, we +restore C<$trace>, C<$single>, and C<$^D>. Next we need to handle C<$@> without getting confused. We save C<$@> in a local lexical, localize C<$saved[0]> (which is where C<save()> will put C<$@>), and then call C<save()> to capture C<$@>, C<$!>, C<$^E>, C<$,>, C<$/>, C<$\>, and C<$^W>) and set C<$,>, C<$/>, C<$\>, and C<$^W> to values considered sane by the debugger. If there was an C<eval()> error, we print -it on the debugger's output. If X<C<$onetimedump>> is defined, we call -X<C<dumpit>> if it's set to 'dump', or X<C<methods>> if it's set to +it on the debugger's output. If C<$onetimedump> is defined, we call +C<dumpit> if it's set to 'dump', or C<methods> if it's set to 'methods'. Setting it to something else causes the debugger to do the eval but not print the result - handy if you want to do something else with it (the "watch expressions" code does this to get the value of the watch @@ -540,9 +548,9 @@ The variables listed below influence C<DB::eval()>'s execution directly. =item C<$evalarg> - the thing to actually be eval'ed -=item C<$trace> - Current state of execution tracing (see X<$trace>) +=item C<$trace> - Current state of execution tracing -=item C<$single> - Current state of single-stepping (see X<$single>) +=item C<$single> - Current state of single-stepping =item C<$onetimeDump> - what is to be displayed after the evaluation @@ -681,6 +689,13 @@ sub eval { # true if $deep is not defined. # # $Log: perl5db.pl,v $ +# Revision 1.9 2004/08/09 18:09:28 millert +# merge 5.8.5 into HEAD +# remove now-unused files +# crank libperl shared library major number +# update Makefile.bsd-wrapper +# tweak openbsd hints file for arm and m68k +# # Revision 1.8 2004/04/07 21:33:04 millert # merge local changes into perl-5.8.3 # @@ -925,6 +940,8 @@ sub eval { # + removed windowid restriction for forking into an xterm. # + more whitespace again. # + wrapped restart and enabled rerun [-n] (go back n steps) command. +# Changes: 1.28: Oct 12, 2004 Richard Foley <richard.foley@rfi.net> +# + Added threads support (inc. e and E commands) #################################################################### =head1 DEBUGGER INITIALIZATION @@ -962,12 +979,57 @@ BEGIN { local ($^W) = 0; # Switch run-time warnings off during init. +=head2 THREADS SUPPORT + +If we are running under a threaded Perl, we require threads and threads::shared +if the environment variable C<PERL5DB_THREADED> is set, to enable proper +threaded debugger control. C<-dt> can also be used to set this. + +Each new thread will be announced and the debugger prompt will always inform +you of each new thread created. It will also indicate the thread id in which +we are currently running within the prompt like this: + + [tid] DB<$i> + +Where C<[tid]> is an integer thread id and C<$i> is the familiar debugger +command prompt. The prompt will show: C<[0]> when running under threads, but +not actually in a thread. C<[tid]> is consistent with C<gdb> usage. + +While running under threads, when you set or delete a breakpoint (etc.), this +will apply to all threads, not just the currently running one. When you are +in a currently executing thread, you will stay there until it completes. With +the current implementation it is not currently possible to hop from one thread +to another. + +The C<e> and C<E> commands are currently fairly minimal - see C<h e> and C<h E>. + +Note that threading support was built into the debugger as of Perl version +C<5.8.6> and debugger version C<1.2.8>. + +=cut + +BEGIN { + # ensure we can share our non-threaded variables or no-op + if ($ENV{PERL5DB_THREADED}) { + require threads; + require threads::shared; + import threads::shared qw(share); + $DBGR; + share(\$DBGR); + lock($DBGR); + print "Threads support enabled\n"; + } else { + *lock = sub(*) {}; + *share = sub(*) {}; + } +} + # This would probably be better done with "use vars", but that wasn't around # when this code was originally written. (Neither was "use strict".) And on # the principle of not fiddling with something that was working, this was # left alone. warn( # Do not ;-) - # These variables control the execution of 'dumpvar.pl'. + # These variables control the execution of 'dumpvar.pl'. $dumpvar::hashDepth, $dumpvar::arrayDepth, $dumpvar::dumpDBFiles, @@ -993,6 +1055,10 @@ warn( # Do not ;-) ) if 0; +foreach my $k (keys (%INC)) { + &share(\$main::{'_<'.$filename}); +}; + # Command-line + PERLLIB: # Save the contents of @INC before they are modified elsewhere. @ini_INC = @INC; @@ -1160,6 +1226,17 @@ $pretype = [] unless defined $pretype; $CreateTTY = 3 unless defined $CreateTTY; $CommandSet = '580' unless defined $CommandSet; +share($rl); +share($warnLevel); +share($dieLevel); +share($signalLevel); +share($pre); +share($post); +share($pretype); +share($rl); +share($CreateTTY); +share($CommandSet); + =pod The default C<die>, C<warn>, and C<signal> handlers are set up. @@ -1199,8 +1276,8 @@ pager( =pod We set up the command to be used to access the man pages, the command -recall character ("!" unless otherwise defined) and the shell escape -character ("!" unless otherwise defined). Yes, these do conflict, and +recall character (C<!> unless otherwise defined) and the shell escape +character (C<!> unless otherwise defined). Yes, these do conflict, and neither works in the debugger at the moment. =cut @@ -1228,7 +1305,7 @@ $maxtrace = 400 unless defined $maxtrace; =head2 SETTING UP THE DEBUGGER GREETING -The debugger 'greeting' helps to inform the user how many debuggers are +The debugger I<greeting> helps to inform the user how many debuggers are running, and whether the current debugger is the primary or a child. If we are the primary, we just hang onto our pid so we'll have it when @@ -1435,6 +1512,11 @@ if ( exists $ENV{PERLDB_RESTART} ) { %break_on_load = get_list("PERLDB_ON_LOAD"); %postponed = get_list("PERLDB_POSTPONE"); + share(@hist); + share(@truehist); + share(%break_on_load); + share(%postponed); + # restore breakpoints/actions my @had_breakpoints = get_list("PERLDB_VISITED"); for ( 0 .. $#had_breakpoints ) { @@ -1471,6 +1553,7 @@ to be anyone there to enter commands. if ($notty) { $runnonstop = 1; + share($runnonstop); } =pod @@ -1525,7 +1608,9 @@ We then determine what the console should be on various systems: } =item * MacOS - use C<Dev:Console:Perl Debug> if this is the MPW version; C<Dev: -Console> if not. (Note that Mac OS X returns 'darwin', not 'MacOS'. Also note that the debugger doesn't do anything special for 'darwin'. Maybe it should.) +Console> if not. + +Note that Mac OS X returns C<darwin>, not C<MacOS>. Also note that the debugger doesn't do anything special for C<darwin>. Maybe it should. =cut @@ -1684,6 +1769,8 @@ and if we can. # and a I/O description to keep track of. $LINEINFO = $OUT unless defined $LINEINFO; $lineinfo = $console unless defined $lineinfo; + # share($LINEINFO); # <- unable to share globs + share($lineinfo); # =pod @@ -1744,7 +1831,7 @@ them, and hen send execution off to the next statement. Note that the order in which the commands are processed is very important; some commands earlier in the loop will actually alter the C<$cmd> variable -to create other commands to be executed later. This is all highly "optimized" +to create other commands to be executed later. This is all highly I<optimized> but can be confusing. Check the comments for each C<$cmd ... && do {}> to see what's happening in any given command. @@ -1752,6 +1839,13 @@ see what's happening in any given command. sub DB { + # lock the debugger and get the thread id for the prompt + lock($DBGR); + my $tid; + if ($ENV{PERL5DB_THREADED}) { + $tid = eval { "[".threads->self->tid."]" }; + } + # Check for whether we should be running continuously or not. # _After_ the perl program is compiled, $single is set to 1: if ( $single and not $second_time++ ) { @@ -1881,13 +1975,21 @@ C<watchfunction()> executes: =over 4 -=item * Returning a false value from the C<watchfunction()> itself. +=item * + +Returning a false value from the C<watchfunction()> itself. + +=item * + +Altering C<$single> to a false value. -=item * Altering C<$single> to a false value. +=item * -=item * Altering C<$signal> to a false value. +Altering C<$signal> to a false value. -=item * Turning off the '4' bit in C<$trace> (this also disables the +=item * + +Turning off the C<4> bit in C<$trace> (this also disables the check for C<watchfunction()>. This can be done with $trace &= ~4; @@ -2071,11 +2173,11 @@ The debugger normally shows the line corresponding to the current line of execution. Sometimes, though, we want to see the next line, or to move elsewhere in the file. This is done via the C<$incr>, C<$start>, and C<$max> variables. -C<$incr> controls by how many lines the "current" line should move forward -after a command is executed. If set to -1, this indicates that the "current" +C<$incr> controls by how many lines the I<current> line should move forward +after a command is executed. If set to -1, this indicates that the I<current> line shouldn't change. -C<$start> is the "current" line. It is used for things like knowing where to +C<$start> is the I<current> line. It is used for things like knowing where to move forwards or backwards from when doing an C<L> or C<-> command. C<$max> tells the debugger where the last line of the current file is. It's @@ -2088,10 +2190,14 @@ in two parts: =over 4 -=item * The outer part of the loop, starting at the C<CMD> label. This loop +=item * + +The outer part of the loop, starting at the C<CMD> label. This loop reads a command and then executes it. -=item * The inner part of the loop, starting at the C<PIPE> label. This part +=item * + +The inner part of the loop, starting at the C<PIPE> label. This part is wholly contained inside the C<CMD> block and only executes a command. Used to handle commands running inside a pager. @@ -2120,7 +2226,7 @@ the new command. This is faster, but perhaps a bit more convoluted. # ... and we got a line of command input ... defined( $cmd = &readline( - "$pidprompt DB" + "$pidprompt $tid DB" . ( '<' x $level ) . ( $#hist + 1 ) . ( '>' x $level ) . " " @@ -2129,6 +2235,7 @@ the new command. This is faster, but perhaps a bit more convoluted. ) { + share($cmd); # ... try to execute the input as debugger commands. # Don't stop running. @@ -2145,7 +2252,7 @@ the new command. This is faster, but perhaps a bit more convoluted. =head4 The null command -A newline entered by itself means "re-execute the last command". We grab the +A newline entered by itself means I<re-execute the last command>. We grab the command out of C<$laststep> (where it was recorded previously), and copy it back into C<$cmd> to be executed below. If there wasn't any previous command, we'll do nothing below (no command will match). If there was, we also save it @@ -2159,6 +2266,8 @@ it up. chomp($cmd); # get rid of the annoying extra newline push( @hist, $cmd ) if length($cmd) > 1; push( @truehist, $cmd ); + share(@hist); + share(@truehist); # This is a restart point for commands that didn't arrive # via direct user input. It allows us to 'redo PIPE' to @@ -2467,7 +2576,7 @@ deal with them instead of processing them in-line. # All of these commands were remapped in perl 5.8.0; # we send them off to the secondary dispatcher (see below). - $cmd =~ /^([aAbBhilLMoOPvwW]\b|[<>\{]{1,2})\s*(.*)/so && do { + $cmd =~ /^([aAbBeEhilLMoOPvwW]\b|[<>\{]{1,2})\s*(.*)/so && do { &cmd_wrapper( $1, $2, $line ); next CMD; }; @@ -2528,7 +2637,7 @@ they can't. =head4 C<n> - single step, but don't trace down into subs Done by setting C<$single> to 2, which forces subs to execute straight through -when entered (see X<DB::sub>). We also save the C<n> command in C<$laststep>, +when entered (see C<DB::sub>). We also save the C<n> command in C<$laststep>, so a null command knows what to re-execute. =cut @@ -2547,7 +2656,7 @@ so a null command knows what to re-execute. =head4 C<s> - single-step, entering subs -Sets C<$single> to 1, which causes X<DB::sub> to continue tracing inside +Sets C<$single> to 1, which causes C<DB::sub> to continue tracing inside subs. Also saves C<s> as C<$lastcmd>. =cut @@ -2925,7 +3034,7 @@ C<STDOUT> from getting messed up. =head4 C<$rc I<pattern> $rc> - Search command history Another command to manipulate C<@hist>: this one searches it with a pattern. -If a command is found, it is placed in C<$cmd> and executed via <redo>. +If a command is found, it is placed in C<$cmd> and executed via C<redo>. =cut @@ -3191,6 +3300,24 @@ Return to any given position in the B<true>-history list $cmd =~ /^(R|rerun\s*(.*))$/ && do { my @args = ($1 eq 'R' ? restart() : rerun($2)); + # Close all non-system fds for a clean restart. A more + # correct method would be to close all fds that were not + # open when the process started, but this seems to be + # hard. See "debugger 'R'estart and open database + # connections" on p5p. + + my $max_fd = 1024; # default if POSIX can't be loaded + if (eval { require POSIX }) { + $max_fd = POSIX::sysconf(POSIX::_SC_OPEN_MAX()); + } + + if (defined $max_fd) { + foreach ($^F+1 .. $max_fd-1) { + next unless open FD_TO_CLOSE, "<&=$_"; + close(FD_TO_CLOSE); + } + } + # And run Perl again. We use exec() to keep the # PID stable (and that way $ini_pids is still valid). exec(@args) || print $OUT "exec failed: $!\n"; @@ -3200,7 +3327,7 @@ Return to any given position in the B<true>-history list =head4 C<|, ||> - pipe output through the pager. -FOR C<|>, we save C<OUT> (the debugger's output filehandle) and C<STDOUT> +For C<|>, we save C<OUT> (the debugger's output filehandle) and C<STDOUT> (the program's standard output). For C<||>, we only save C<OUT>. We open a pipe to the pager (restoring the output filehandles if this fails). If this is the C<|> command, we also set up a C<SIGPIPE> handler which will simply @@ -3428,7 +3555,7 @@ the 16 bit is set in C<$frame>). It also tracks the subroutine call depth by saving the current setting of C<$single> in the C<@stack> package global; if this exceeds the value in C<$deep>, C<sub> automatically turns on printing of the current depth by -setting the 4 bit in C<$single>. In any case, it keeps the current setting +setting the C<4> bit in C<$single>. In any case, it keeps the current setting of stop/don't stop on entry to subs set as it currently is set. =head3 C<caller()> support @@ -3452,7 +3579,7 @@ The line number it was defined on =item * C<$subroutine> -The subroutine name; C<'(eval)'> if an C<eval>(). +The subroutine name; C<(eval)> if an C<eval>(). =item * C<$hasargs> @@ -3476,7 +3603,7 @@ pragma information; subject to change between versions =item * C<$bitmask> -pragma information: subject to change between versions +pragma information; subject to change between versions =item * C<@DB::args> @@ -3488,10 +3615,16 @@ arguments with which the subroutine was invoked sub sub { + # lock ourselves under threads + lock($DBGR); + # Whether or not the autoloader was running, a scalar to put the # sub's return value in (if needed), and an array to put the sub's # return value in (if needed). my ( $al, $ret, @ret ) = ""; + if ($sub =~ /^threads::new$/ && $ENV{PERL5DB_THREADED}) { + print "creating new thread\n"; + } # If the last ten characters are C'::AUTOLOAD', note we've traced # into AUTOLOAD for $sub. @@ -3680,8 +3813,8 @@ The C<%set> hash defines the mapping from command letter to subroutine name suffix. C<%set> is a two-level hash, indexed by set name and then by command name. -Note that trying to set the CommandSet to 'foobar' simply results in the -5.8.0 command set being used, since there's no top-level entry for 'foobar'. +Note that trying to set the CommandSet to C<foobar> simply results in the +5.8.0 command set being used, since there's no top-level entry for C<foobar>. =cut @@ -3718,7 +3851,7 @@ my %set = ( # C<cmd_wrapper()> allows the debugger to switch command sets depending on the value of the C<CommandSet> option. -It tries to look up the command in the X<C<%set>> package-level I<lexical> +It tries to look up the command in the C<%set> package-level I<lexical> (which means external entities can't fiddle with it) and create the name of the sub to call based on the value found in the hash (if it's there). I<All> of the commands to be handled in a set have to be added to C<%set>; if they @@ -4024,24 +4157,31 @@ worked on (if it's not the current one). We can now build functions in pairs: the basic function works on the current file, and uses C<$filename_error> as part of its error message. Since this is -initialized to C<''>, no filename will appear when we are working on the +initialized to C<"">, no filename will appear when we are working on the current file. The second function is a wrapper which does the following: =over 4 -=item * Localizes C<$filename_error> and sets it to the name of the file to be processed. +=item * + +Localizes C<$filename_error> and sets it to the name of the file to be processed. -=item * Localizes the C<*dbline> glob and reassigns it to point to the file we want to process. +=item * -=item * Calls the first function. +Localizes the C<*dbline> glob and reassigns it to point to the file we want to process. -The first function works on the "current" (i.e., the one we changed to) file, +=item * + +Calls the first function. + +The first function works on the I<current> file (i.e., the one we changed to), and prints C<$filename_error> in the error message (the name of the other file) -if it needs to. When the functions return, C<*dbline> is restored to point to the actual current file (the one we're executing in) and C<$filename_error> is -restored to C<''>. This restores everything to the way it was before the -second function was called at all. +if it needs to. When the functions return, C<*dbline> is restored to point +to the actual current file (the one we're executing in) and +C<$filename_error> is restored to C<"">. This restores everything to +the way it was before the second function was called at all. See the comments in C<breakable_line> and C<breakable_line_in_file> for more details. @@ -4052,7 +4192,7 @@ details. $filename_error = ''; -=head3 breakable_line($from, $to) (API) +=head3 breakable_line(from, to) (API) The subroutine decides whether or not a line in the current file is breakable. It walks through C<@dbline> within the range of lines specified, looking for @@ -4135,7 +4275,7 @@ sub breakable_line { die "Line$pl $from$upto$filename_error not breakable\n"; } ## end sub breakable_line -=head3 breakable_line_in_filename($file, $from, $to) (API) +=head3 breakable_line_in_filename(file, from, to) (API) Like C<breakable_line>, but look in another file. @@ -4494,15 +4634,66 @@ sub cmd_stop { # As on ^C, but not signal-safy. $signal = 1; } +=head3 C<cmd_e> - threads + +Display the current thread id: + + e + +This could be how (when implemented) to send commands to this thread id (e cmd) +or that thread id (e tid cmd). + +=cut + +sub cmd_e { + my $cmd = shift; + my $line = shift; + unless (exists($INC{'threads.pm'})) { + print "threads not loaded($ENV{PERL5DB_THREADED}) + please run the debugger with PERL5DB_THREADED=1 set in the environment\n"; + } else { + my $tid = threads->self->tid; + print "thread id: $tid\n"; + } +} ## end sub cmd_e + +=head3 C<cmd_E> - list of thread ids + +Display the list of available thread ids: + + E + +This could be used (when implemented) to send commands to all threads (E cmd). + +=cut + +sub cmd_E { + my $cmd = shift; + my $line = shift; + unless (exists($INC{'threads.pm'})) { + print "threads not loaded($ENV{PERL5DB_THREADED}) + please run the debugger with PERL5DB_THREADED=1 set in the environment\n"; + } else { + my $tid = threads->self->tid; + print "thread ids: ".join(', ', + map { ($tid == $_->tid ? '<'.$_->tid.'>' : $_->tid) } threads->list + )."\n"; + } +} ## end sub cmd_E + =head3 C<cmd_h> - help command (command) Does the work of either =over 4 -=item * Showing all the debugger help +=item * -=item * Showing help for a specific command +Showing all the debugger help + +=item * + +Showing help for a specific command =back @@ -5070,7 +5261,7 @@ watch expressions. If an expression (or partial expression) is specified, we pattern-match through the expressions and remove the ones that match. We also discard the corresponding values. If no watch expressions are left, we turn off -the 'watching expressions' bit. +the I<watching expressions> bit. =cut @@ -5130,10 +5321,14 @@ sub cmd_W { These are general support routines that are used in a number of places throughout the debugger. +=over 4 + =item cmd_P Something to do with assertions +=back + =cut sub cmd_P { @@ -5343,7 +5538,7 @@ prevent return values from being shown. C<dumpit()> then checks to see if it needs to load C<dumpvar.pl> and tries to load it (note: if you have a C<dumpvar.pl> ahead of the -installed version in @INC, yours will be used instead. Possible security +installed version in C<@INC>, yours will be used instead. Possible security problem?). It then checks to see if the subroutine C<main::dumpValue> is now defined @@ -5421,13 +5616,21 @@ Parameters: =over 4 -=item * The filehandle to print to. +=item * + +The filehandle to print to. + +=item * + +How many frames to skip before starting trace. -=item * How many frames to skip before starting trace. +=item * -=item * How many frames to print. +How many frames to print. -=item * A flag: if true, print a "short" trace without filenames, line numbers, or arguments +=item * + +A flag: if true, print a I<short> trace without filenames, line numbers, or arguments =back @@ -5692,7 +5895,7 @@ This routine mostly just packages up a regular expression to be used to check that the thing it's being matched against has properly-matched curly braces. -Of note is the definition of the $balanced_brace_re global via ||=, which +Of note is the definition of the C<$balanced_brace_re> global via C<||=>, which speeds things up by only creating the qr//'ed expression once; if it's already defined, we don't try to define it again. A speed hack. @@ -5717,7 +5920,7 @@ sub unbalanced { C<gets()> is a primitive (very primitive) routine to read continuations. It was devised for reading continuations for actions. -it just reads more input with X<C<readline()>> and returns it. +it just reads more input with C<readline()> and returns it. =cut @@ -6260,11 +6463,11 @@ sub option_val { Handles the parsing and execution of option setting/displaying commands. -An option entered by itself is assumed to be 'set me to 1' (the default value) +An option entered by itself is assumed to be I<set me to 1> (the default value) if the option is a boolean one. If not, the user is prompted to enter a valid -value or to query the current value (via 'option? '). +value or to query the current value (via C<option? >). -If 'option=value' is entered, we try to extract a quoted string from the +If C<option=value> is entered, we try to extract a quoted string from the value (if it is quoted). If it's not, we just use the whole value as-is. We load any modules required to service this option, and then we set it: if @@ -6446,7 +6649,7 @@ sub get_list { The C<catch()> subroutine is the essence of fast and low-impact. We simply set an already-existing global scalar variable to a constant value. This avoids allocating any memory possibly in the middle of something that will -get all confused if we do. +get all confused if we do, particularily under I<unsafe signals>. =cut @@ -6589,7 +6792,7 @@ sub noTTY { =head2 C<ReadLine> Sets the C<$rl> option variable. If 0, we use C<Term::ReadLine::Stub> -(essentially, no C<readline> processing on this "terminal"). Otherwise, we +(essentially, no C<readline> processing on this I<terminal>). Otherwise, we use C<Term::ReadLine>. Can't be changed after a terminal's in place; we save the value in case a restart is done so we can change it then. @@ -6814,9 +7017,9 @@ These subroutines provide functionality for various commands. =head2 C<list_modules> For the C<M> command: list modules loaded and their versions. -Essentially just runs through the keys in %INC, picks up the -$VERSION package globals from each package, gets the file name, and formats the -information for output. +Essentially just runs through the keys in %INC, picks each package's +C<$VERSION> variable, gets the file name, and formats the information +for output. =cut @@ -6854,14 +7057,15 @@ Sets up the monster string used to format and print the help. =head3 HELP MESSAGE FORMAT -The help message is a peculiar format unto itself; it mixes C<pod> 'ornaments' -(BE<lt>E<gt>, IE<gt>E<lt>) with tabs to come up with a format that's fairly +The help message is a peculiar format unto itself; it mixes C<pod> I<ornaments> +(C<< B<> >> C<< I<> >>) with tabs to come up with a format that's fairly easy to parse and portable, but which still allows the help to be a little nicer than just plain text. -Essentially, you define the command name (usually marked up with BE<gt>E<lt> -and IE<gt>E<lt>), followed by a tab, and then the descriptive text, ending in a newline. The descriptive text can also be marked up in the same way. If you -need to continue the descriptive text to another line, start that line with +Essentially, you define the command name (usually marked up with C<< B<> >> +and C<< I<> >>), followed by a tab, and then the descriptive text, ending in a +newline. The descriptive text can also be marked up in the same way. If you +need to continue the descriptive text to another line, start that line with just tabs and then enter the marked-up text. If you are modifying the help text, I<be careful>. The help-string parser is @@ -6947,6 +7151,8 @@ B<m> I<expr> Evals expression in list context, prints methods callable B<m> I<class> Prints methods callable via the given class. B<M> Show versions of loaded modules. B<i> I<class> Prints nested parents of given class. +B<e> Display current thread id. +B<E> Display all thread ids the current one will be identified: <n>. B<y> [I<n> [I<Vars>]] List lexicals in higher scope <n>. Vars same as B<V>. B<P> Something to do with assertions... @@ -7064,6 +7270,7 @@ I<Data Examination:> B<expr> Execute perl code, also see: B<s>,B<n>,B<t> B<V> [I<Pk> [I<Vars>]] List Variables in Package. Vars can be ~pattern or !pattern. B<X> [I<Vars>] Same as \"B<V> I<current_package> [I<Vars>]\". B<i> I<class> inheritance tree. B<y> [I<n> [I<Vars>]] List lexicals in higher scope <n>. Vars same as B<V>. + B<e> Display thread id B<E> Display all thread ids. For more help, type B<h> I<cmd_letter>, or run B<$doccmd perldebug> for all docs. END_SUM @@ -7249,7 +7456,7 @@ END_SUM Most of what C<print_help> does is just text formatting. It finds the C<B> and C<I> ornaments, cleans them off, and substitutes the proper terminal control characters to simulate them (courtesy of -<Term::ReadLine::TermCap>). +C<Term::ReadLine::TermCap>). =cut @@ -7592,9 +7799,9 @@ to named subroutines (including those aliased via glob assignment). =head2 C<CvGV_name()> -Wrapper for X<CvGV_name_or_bust>; tries to get the name of a reference +Wrapper for C<CvGV_name_or_bust>; tries to get the name of a reference via that routine. If this fails, return the reference again (when the -reference is stringified, it'll come out as "SOMETHING(0X...)"). +reference is stringified, it'll come out as C<SOMETHING(0x...)>). =cut @@ -7610,7 +7817,7 @@ Calls L<Devel::Peek> to try to find the glob the ref lives in; returns C<undef> if L<Devel::Peek> can't be loaded, or if C<Devel::Peek::CvGV> can't find a glob for this ref. -Returns "I<package>::I<glob name>" if the code ref is found in a glob. +Returns C<< I<package>::I<glob name> >> if the code ref is found in a glob. =cut @@ -7629,10 +7836,10 @@ sub CvGV_name_or_bust { A utility routine used in various places; finds the file where a subroutine was defined, and returns that filename and a line-number range. -Tries to use X<@sub> first; if it can't find it there, it tries building a -reference to the subroutine and uses X<CvGV_name_or_bust> to locate it, -loading it into X<@sub> as a side effect (XXX I think). If it can't find it -this way, it brute-force searches X<%sub>, checking for identical references. +Tries to use C<@sub> first; if it can't find it there, it tries building a +reference to the subroutine and uses C<CvGV_name_or_bust> to locate it, +loading it into C<@sub> as a side effect (XXX I think). If it can't find it +this way, it brute-force searches C<%sub>, checking for identical references. =cut @@ -7657,7 +7864,7 @@ sub find_sub { =head2 C<methods> -A subroutine that uses the utility function X<methods_via> to find all the +A subroutine that uses the utility function C<methods_via> to find all the methods in the class corresponding to the current reference and in C<UNIVERSAL>. @@ -7963,27 +8170,49 @@ debugger has to have set up before the Perl core starts running: =over 4 -=item * The debugger's own filehandles (copies of STD and STDOUT for now). +=item * + +The debugger's own filehandles (copies of STD and STDOUT for now). + +=item * + +Characters for shell escapes, the recall command, and the history command. + +=item * + +The maximum recursion depth. -=item * Characters for shell escapes, the recall command, and the history command. +=item * -=item * The maximum recursion depth. +The size of a C<w> command's window. -=item * The size of a C<w> command's window. +=item * -=item * The before-this-line context to be printed in a C<v> (view a window around this line) command. +The before-this-line context to be printed in a C<v> (view a window around this line) command. -=item * The fact that we're not in a sub at all right now. +=item * -=item * The default SIGINT handler for the debugger. +The fact that we're not in a sub at all right now. -=item * The appropriate value of the flag in C<$^D> that says the debugger is running +=item * -=item * The current debugger recursion level +The default SIGINT handler for the debugger. -=item * The list of postponed (XXX define) items and the C<$single> stack +=item * -=item * That we want no return values and no subroutine entry/exit trace. +The appropriate value of the flag in C<$^D> that says the debugger is running + +=item * + +The current debugger recursion level + +=item * + +The list of postponed items and the C<$single> stack (XXX define this) + +=item * + +That we want no return values and no subroutine entry/exit trace. =back @@ -8092,15 +8321,25 @@ sub db_complete { =over 4 -=item * Find all the subroutines that might match in this package +=item * -=item * Add "postpone", "load", and "compile" as possibles (we may be completing the keyword itself +Find all the subroutines that might match in this package -=item * Include all the rest of the subs that are known +=item * -=item * C<grep> out the ones that match the text we have so far +Add C<postpone>, C<load>, and C<compile> as possibles (we may be completing the keyword itself -=item * Return this as the list of possible completions +=item * + +Include all the rest of the subs that are known + +=item * + +C<grep> out the ones that match the text we have so far + +=item * + +Return this as the list of possible completions =back @@ -8113,7 +8352,7 @@ sub db_complete { =head3 C<b load> -Get all the possible files from @INC as it currently stands and +Get all the possible files from C<@INC> as it currently stands and select the ones that match the text so far. =cut @@ -8221,7 +8460,9 @@ Much like the above, except we have to do a little more cleanup: =over 4 -=item * Determine the package that the symbol is in. Put it in C<::> (effectively C<main::>) if no package is specified. +=item * + +Determine the package that the symbol is in. Put it in C<::> (effectively C<main::>) if no package is specified. =cut @@ -8229,7 +8470,9 @@ Much like the above, except we have to do a little more cleanup: =pod -=item * Figure out the prefix vs. what needs completing. +=item * + +Figure out the prefix vs. what needs completing. =cut @@ -8238,7 +8481,9 @@ Much like the above, except we have to do a little more cleanup: =pod -=item * Look through all the symbols in the package. C<grep> out all the possible hashes/arrays/scalars, and then C<grep> the possible matches out of those. C<map> the prefix onto all the possibilities. +=item * + +Look through all the symbols in the package. C<grep> out all the possible hashes/arrays/scalars, and then C<grep> the possible matches out of those. C<map> the prefix onto all the possibilities. =cut @@ -8247,7 +8492,9 @@ Much like the above, except we have to do a little more cleanup: =pod -=item * If there's only one hit, and it's a package qualifier, and it's not equal to the initial text, re-complete it using the symbol we actually found. +=item * + +If there's only one hit, and it's a package qualifier, and it's not equal to the initial text, re-complete it using the symbol we actually found. =cut @@ -8274,7 +8521,9 @@ Much like the above, except we have to do a little more cleanup: =over 4 -=item * If it's C<main>, delete main to just get C<::> leading. +=item * + +If it's C<main>, delete main to just get C<::> leading. =cut @@ -8282,7 +8531,9 @@ Much like the above, except we have to do a little more cleanup: =pod -=item * We set the prefix to the item's sigil, and trim off the sigil to get the text to be completed. +=item * + +We set the prefix to the item's sigil, and trim off the sigil to get the text to be completed. =cut @@ -8291,7 +8542,9 @@ Much like the above, except we have to do a little more cleanup: =pod -=item * If the package is C<::> (C<main>), create an empty list; if it's something else, create a list of all the packages known. Append whichever list to a list of all the possible symbols in the current package. C<grep> out the matches to the text entered so far, then C<map> the prefix back onto the symbols. +=item * + +If the package is C<::> (C<main>), create an empty list; if it's something else, create a list of all the packages known. Append whichever list to a list of all the possible symbols in the current package. C<grep> out the matches to the text entered so far, then C<map> the prefix back onto the symbols. =cut @@ -8299,7 +8552,9 @@ Much like the above, except we have to do a little more cleanup: ( grep /^_?[a-zA-Z]/, keys %$pack ), ( $pack eq '::' ? () : ( grep /::$/, keys %:: ) ); -=item * If there's only one hit, it's a package qualifier, and it's not equal to the initial text, recomplete using this symbol. +=item * + +If there's only one hit, it's a package qualifier, and it's not equal to the initial text, recomplete using this symbol. =back @@ -8481,6 +8736,8 @@ sub expand_DollarCaretP_flags { return @bits ? join( '|', @bits ) : 0; } +=over 4 + =item rerun Rerun the current session to: @@ -8718,6 +8975,8 @@ from the environment. }; # end restart +=back + =head1 END PROCESSING - THE C<END> BLOCK Come here at the very end of processing. We want to go into a @@ -8731,7 +8990,7 @@ We then figure out whether we're truly done (as in the user entered a C<q> command, or we finished execution while running nonstop). If we aren't, we set C<$single> to 1 (causing the debugger to get control again). -We then call C<DB::fake::at_exit()>, which returns the C<Use 'q' to quit ..."> +We then call C<DB::fake::at_exit()>, which returns the C<Use 'q' to quit ...> message and returns control to the debugger. Repeat. When the user finally enters a C<q> command, C<$fall_off_end> is set to @@ -8761,7 +9020,7 @@ comments to keep things clear. =head2 Null command -Does nothing. Used to 'turn off' commands. +Does nothing. Used to I<turn off> commands. =cut @@ -9060,7 +9319,7 @@ sub cmd_pre590_prepost { =head2 C<cmd_prepost> -Actually does all the handling foe C<E<lt>>, C<E<gt>>, C<{{>, C<{>, etc. +Actually does all the handling for C<E<lt>>, C<E<gt>>, C<{{>, C<{>, etc. Since the lists of actions are all held in arrays that are pointed to by references anyway, all we have to do is pick the right array reference and then use generic code to all, delete, or list actions. diff --git a/gnu/usr.bin/perl/malloc.c b/gnu/usr.bin/perl/malloc.c index 6013e400837..6d5635228aa 100644 --- a/gnu/usr.bin/perl/malloc.c +++ b/gnu/usr.bin/perl/malloc.c @@ -6,6 +6,12 @@ * "'The Chamber of Records,' said Gimli. 'I guess that is where we now stand.'" */ +/* This file contains Perl's own implementation of the malloc library. + * It is used if Configure decides that, on your platform, Perl's + * version is better than the OS's, or if you give Configure the + * -Dusemymalloc command-line option. + */ + /* Here are some notes on configuring Perl's malloc. (For non-perl usage see below.) @@ -357,6 +363,7 @@ # define Free_t void # endif # define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) +# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) # define PerlEnv_getenv getenv # define PerlIO_printf fprintf # define PerlIO_stderr() stderr @@ -2311,8 +2318,7 @@ Perl_strdup(const char *s) MEM_SIZE l = strlen(s); char *s1 = (char *)Perl_malloc(l+1); - Copy(s, s1, (MEM_SIZE)(l+1), char); - return s1; + return CopyD(s, s1, (MEM_SIZE)(l+1), char); } #ifdef PERL_CORE diff --git a/gnu/usr.bin/perl/mg.c b/gnu/usr.bin/perl/mg.c index 3f2b191e00f..69e66119229 100644 --- a/gnu/usr.bin/perl/mg.c +++ b/gnu/usr.bin/perl/mg.c @@ -15,6 +15,24 @@ /* =head1 Magical Functions + +"Magic" is special data attached to SV structures in order to give them +"magical" properties. When any Perl code tries to read from, or assign to, +an SV marked as magical, it calls the 'get' or 'set' function associated +with that SV's magic. A get is called prior to reading an SV, in order to +give it a chance to update its internal value (get on $. writes the line +number of the last read filehandle into to the SV's IV slot), while +set is called after an SV has been written to, in order to allow it to make +use of its changed value (set on $/ copies the SV's new value to the +PL_rs global variable). + +Magic is implemented as a linked list of MAGIC structures attached to the +SV. Each MAGIC struct holds the type of the magic, a pointer to an array +of functions that implement the get(), set(), length() etc functions, +plus space for some flags and pointers. For example, a tied variable has +a MAGIC structure that contains a pointer to the object associated with the +tie. + */ #include "EXTERN.h" @@ -124,6 +142,18 @@ Perl_mg_get(pTHX_ SV *sv) int new = 0; MAGIC *newmg, *head, *cur, *mg; I32 mgs_ix = SSNEW(sizeof(MGS)); + int was_temp = SvTEMP(sv); + /* guard against sv having being freed midway by holding a private + reference. */ + + /* sv_2mortal has this side effect of turning on the TEMP flag, which can + cause the SV's buffer to get stolen (and maybe other stuff). + So restore it. + */ + sv_2mortal(SvREFCNT_inc(sv)); + if (!was_temp) { + SvTEMP_off(sv); + } save_magic(mgs_ix, sv); @@ -138,10 +168,6 @@ Perl_mg_get(pTHX_ SV *sv) if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) { CALL_FPTR(vtbl->svt_get)(aTHX_ sv, mg); - /* guard against sv having been freed */ - if (SvTYPE(sv) == SVTYPEMASK) { - Perl_croak(aTHX_ "Tied variable freed while still in use"); - } /* guard against magic having been deleted - eg FETCH calling * untie */ if (!SvMAGIC(sv)) @@ -173,6 +199,12 @@ Perl_mg_get(pTHX_ SV *sv) } restore_magic(aTHX_ INT2PTR(void *, (IV)mgs_ix)); + + if (SvREFCNT(sv) == 1) { + /* We hold the last reference to this SV, which implies that the + SV was deleted as a side effect of the routines we called. */ + SvOK_off(sv); + } return 0; } @@ -661,7 +693,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) case '\023': /* ^S */ if (*(mg->mg_ptr+1) == '\0') { if (PL_lex_state != LEX_NOTPARSING) - (void)SvOK_off(sv); + SvOK_off(sv); else if (PL_in_eval) sv_setiv(sv, PL_in_eval & ~(EVAL_INREQUIRE)); else @@ -1046,6 +1078,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) # endif { # ifndef PERL_USE_SAFE_PUTENV + if (!PL_use_safe_putenv) { I32 i; if (environ == PL_origenviron) @@ -1053,6 +1086,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) else for (i = 0; environ[i]; i++) safesysfree(environ[i]); + } # endif /* PERL_USE_SAFE_PUTENV */ environ[0] = Nullch; @@ -1652,7 +1686,7 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg) return 0; } } - (void)SvOK_off(sv); + SvOK_off(sv); return 0; } @@ -1820,7 +1854,7 @@ Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg) SV *lsv = LvTARG(sv); if (!lsv) { - (void)SvOK_off(sv); + SvOK_off(sv); return 0; } @@ -1941,7 +1975,7 @@ Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg) Perl_croak(aTHX_ "panic: magic_killbackrefs"); /* XXX Should we check that it hasn't changed? */ SvRV(svp[i]) = 0; - (void)SvOK_off(svp[i]); + SvOK_off(svp[i]); SvWEAKREF_off(svp[i]); svp[i] = Nullsv; } @@ -2044,7 +2078,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) case '\004': /* ^D */ #ifdef DEBUGGING s = SvPV_nolen(sv); - PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG; + PL_debug = get_debug_opts_flags(&s, 0) | DEBUG_TOP_FLAG; DEBUG_x(dump_all()); #else PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG; diff --git a/gnu/usr.bin/perl/miniperlmain.c b/gnu/usr.bin/perl/miniperlmain.c index e4b0b200334..c61a39bac00 100644 --- a/gnu/usr.bin/perl/miniperlmain.c +++ b/gnu/usr.bin/perl/miniperlmain.c @@ -12,9 +12,18 @@ * "The Road goes ever on and on, down from the door where it began." */ +/* This file contains the main() function for the perl interpreter. + * Note that miniperlmain.c contains main() for the 'miniperl' binary, + * while perlmain.c contains main() for the 'perl' binary. + * + * Miniperl is like perl except that it does not support dynamic loading, + * and in fact is used to build the dynamic modules needed for the 'real' + * perl executable. + */ + #ifdef OEMVS #ifdef MYMALLOC -/* sbrk is limited to first heap segement so make it big */ +/* sbrk is limited to first heap segment so make it big */ #pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON)) #else #pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON)) @@ -39,6 +48,9 @@ int main(int argc, char **argv, char **env) { int exitstatus; +#ifndef PERL_USE_SAFE_PUTENV + PL_use_safe_putenv = 0; +#endif /* PERL_USE_SAFE_PUTENV */ #ifdef PERL_GLOBAL_STRUCT #define PERLVAR(var,type) /**/ diff --git a/gnu/usr.bin/perl/op.c b/gnu/usr.bin/perl/op.c index b4ded2b7288..1c6452ef0a0 100644 --- a/gnu/usr.bin/perl/op.c +++ b/gnu/usr.bin/perl/op.c @@ -16,6 +16,62 @@ * either way, as the saying is, if you follow me." --the Gaffer */ +/* This file contains the functions that create, manipulate and optimize + * the OP structures that hold a compiled perl program. + * + * A Perl program is compiled into a tree of OPs. Each op contains + * structural pointers (eg to its siblings and the next op in the + * execution sequence), a pointer to the function that would execute the + * op, plus any data specific to that op. For example, an OP_CONST op + * points to the pp_const() function and to an SV containing the constant + * value. When pp_const() is executed, its job is to push that SV onto the + * stack. + * + * OPs are mainly created by the newFOO() functions, which are mainly + * called from the parser (in perly.y) as the code is parsed. For example + * the Perl code $a + $b * $c would cause the equivalent of the following + * to be called (oversimplifying a bit): + * + * newBINOP(OP_ADD, flags, + * newSVREF($a), + * newBINOP(OP_MULTIPLY, flags, newSVREF($b), newSVREF($c)) + * ) + * + * Note that during the build of miniperl, a temporary copy of this file + * is made, called opmini.c. + */ + +/* +Perl's compiler is essentially a 3-pass compiler with interleaved phases: + + A bottom-up pass + A top-down pass + An execution-order pass + +The bottom-up pass is represented by all the "newOP" routines and +the ck_ routines. The bottom-upness is actually driven by yacc. +So at the point that a ck_ routine fires, we have no idea what the +context is, either upward in the syntax tree, or either forward or +backward in the execution order. (The bottom-up parser builds that +part of the execution order it knows about, but if you follow the "next" +links around, you'll find it's actually a closed loop through the +top level node. + +Whenever the bottom-up parser gets to a node that supplies context to +its components, it invokes that portion of the top-down pass that applies +to that part of the subtree (and marks the top node as processed, so +if a node further up supplies context, it doesn't have to take the +plunge again). As a particular subcase of this, as the new node is +built, it takes all the closed execution loops of its subcomponents +and links them into a new closed loop for the higher level node. But +it's still not the real execution order. + +The actual execution order is not known till we get a grammar reduction +to a top-level unit like a subroutine or file that will be called by +"name" rather than via a "next" pointer. At that point, we can call +into peep() to do that code's portion of the 3rd pass. It has to be +recursive, but it's recursive on basic blocks, not on tree nodes. +*/ #include "EXTERN.h" #define PERL_IN_OP_C @@ -4799,7 +4855,8 @@ Perl_newSVREF(pTHX_ OP *o) return newUNOP(OP_RV2SV, 0, scalar(o)); } -/* Check routines. */ +/* Check routines. See the comments at the top of this file for details + * on when these are called */ OP * Perl_ck_anoncode(pTHX_ OP *o) @@ -5965,7 +6022,7 @@ S_simplify_sort(pTHX_ OP *o) { register OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ OP *k; - int reversed; + int descending; GV *gv; if (!(o->op_flags & OPf_STACKED)) return; @@ -5994,11 +6051,12 @@ S_simplify_sort(pTHX_ OP *o) if (GvSTASH(gv) != PL_curstash) return; if (strEQ(GvNAME(gv), "a")) - reversed = 0; + descending = 0; else if (strEQ(GvNAME(gv), "b")) - reversed = 1; + descending = 1; else return; + kid = k; /* back to cmp */ if (kBINOP->op_last->op_type != OP_RV2SV) return; @@ -6008,13 +6066,13 @@ S_simplify_sort(pTHX_ OP *o) kid = kUNOP->op_first; /* get past rv2sv */ gv = kGVOP_gv; if (GvSTASH(gv) != PL_curstash - || ( reversed + || ( descending ? strNE(GvNAME(gv), "a") : strNE(GvNAME(gv), "b"))) return; o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL); - if (reversed) - o->op_private |= OPpSORT_REVERSE; + if (descending) + o->op_private |= OPpSORT_DESCEND; if (k->op_type == OP_NCMP) o->op_private |= OPpSORT_NUMERIC; if (k->op_type == OP_I_NCMP) @@ -6354,7 +6412,9 @@ Perl_ck_substr(pTHX_ OP *o) return o; } -/* A peephole optimizer. We visit the ops in the order they're to execute. */ +/* A peephole optimizer. We visit the ops in the order they're to execute. + * See the comments at the top of this file for more details about when + * peep() is called */ void Perl_peep(pTHX_ register OP *o) @@ -6722,18 +6782,38 @@ Perl_peep(pTHX_ register OP *o) } case OP_SORT: { - /* make @a = sort @a act in-place */ - /* will point to RV2AV or PADAV op on LHS/RHS of assign */ OP *oleft, *oright; OP *o2; - o->op_seq = PL_op_seqmax++; - /* check that RHS of sort is a single plain array */ oright = cUNOPo->op_first; if (!oright || oright->op_type != OP_PUSHMARK) break; + + /* reverse sort ... can be optimised. */ + if (!cUNOPo->op_sibling) { + /* Nothing follows us on the list. */ + OP *reverse = o->op_next; + + if (reverse->op_type == OP_REVERSE && + (reverse->op_flags & OPf_WANT) == OPf_WANT_LIST) { + OP *pushmark = cUNOPx(reverse)->op_first; + if (pushmark && (pushmark->op_type == OP_PUSHMARK) + && (cUNOPx(pushmark)->op_sibling == o)) { + /* reverse -> pushmark -> sort */ + o->op_private |= OPpSORT_REVERSE; + op_null(reverse); + pushmark->op_next = oright->op_next; + op_null(oright); + } + } + } + + /* make @a = sort @a act in-place */ + + o->op_seq = PL_op_seqmax++; + oright = cUNOPx(oright)->op_sibling; if (!oright) break; @@ -6819,9 +6899,97 @@ Perl_peep(pTHX_ register OP *o) break; } - + case OP_REVERSE: { + OP *ourmark, *theirmark, *ourlast, *iter, *expushmark, *rv2av; + OP *gvop = NULL; + LISTOP *enter, *exlist; + o->op_seq = PL_op_seqmax++; + + enter = (LISTOP *) o->op_next; + if (!enter) + break; + if (enter->op_type == OP_NULL) { + enter = (LISTOP *) enter->op_next; + if (!enter) + break; + } + /* for $a (...) will have OP_GV then OP_RV2GV here. + for (...) just has an OP_GV. */ + if (enter->op_type == OP_GV) { + gvop = (OP *) enter; + enter = (LISTOP *) enter->op_next; + if (!enter) + break; + if (enter->op_type == OP_RV2GV) { + enter = (LISTOP *) enter->op_next; + if (!enter) + break; + } + } + + if (enter->op_type != OP_ENTERITER) + break; + + iter = enter->op_next; + if (!iter || iter->op_type != OP_ITER) + break; + + expushmark = enter->op_first; + if (!expushmark || expushmark->op_type != OP_NULL + || expushmark->op_targ != OP_PUSHMARK) + break; + + exlist = (LISTOP *) expushmark->op_sibling; + if (!exlist || exlist->op_type != OP_NULL + || exlist->op_targ != OP_LIST) + break; + + if (exlist->op_last != o) { + /* Mmm. Was expecting to point back to this op. */ + break; + } + theirmark = exlist->op_first; + if (!theirmark || theirmark->op_type != OP_PUSHMARK) + break; + + if (theirmark->op_sibling != o) { + /* There's something between the mark and the reverse, eg + for (1, reverse (...)) + so no go. */ + break; + } + + ourmark = ((LISTOP *)o)->op_first; + if (!ourmark || ourmark->op_type != OP_PUSHMARK) + break; + + ourlast = ((LISTOP *)o)->op_last; + if (!ourlast || ourlast->op_next != o) + break; + + rv2av = ourmark->op_sibling; + if (rv2av && rv2av->op_type == OP_RV2AV && rv2av->op_sibling == 0 + && rv2av->op_flags == (OPf_WANT_LIST | OPf_KIDS) + && enter->op_flags == (OPf_WANT_LIST | OPf_KIDS)) { + /* We're just reversing a single array. */ + rv2av->op_flags = OPf_WANT_SCALAR | OPf_KIDS | OPf_REF; + enter->op_flags |= OPf_STACKED; + } + /* We don't have control over who points to theirmark, so sacrifice + ours. */ + theirmark->op_next = ourmark->op_next; + theirmark->op_flags = ourmark->op_flags; + ourlast->op_next = gvop ? gvop : (OP *) enter; + op_null(ourmark); + op_null(o); + enter->op_private |= OPpITER_REVERSED; + iter->op_private |= OPpITER_REVERSED; + + break; + } + default: o->op_seq = PL_op_seqmax++; break; diff --git a/gnu/usr.bin/perl/op.h b/gnu/usr.bin/perl/op.h index c917c499039..5a1fed99503 100644 --- a/gnu/usr.bin/perl/op.h +++ b/gnu/usr.bin/perl/op.h @@ -171,6 +171,9 @@ Deprecated. Use C<GIMME_V> instead. /* (lower bits may carry MAXARG) */ #define OPpTARGET_MY 16 /* Target is PADMY. */ +/* Private for OP_ENTERITER and OP_ITER */ +#define OPpITER_REVERSED 4 /* for (reverse ...) */ + /* Private for OP_CONST */ #define OPpCONST_SHORTCIRCUIT 4 /* eg the constant 5 in (5 || foo) */ #define OPpCONST_STRICT 8 /* bearword subject to strict 'subs' */ @@ -194,8 +197,9 @@ Deprecated. Use C<GIMME_V> instead. /* Private for OP_SORT */ #define OPpSORT_NUMERIC 1 /* Optimized away { $a <=> $b } */ #define OPpSORT_INTEGER 2 /* Ditto while under "use integer" */ -#define OPpSORT_REVERSE 4 /* Descending sort */ +#define OPpSORT_REVERSE 4 /* Reversed sort */ #define OPpSORT_INPLACE 8 /* sort in-place; eg @a = sort @a */ +#define OPpSORT_DESCEND 16 /* Descending sort */ /* Private for OP_THREADSV */ #define OPpDONE_SVREF 64 /* Been through newSVREF once */ diff --git a/gnu/usr.bin/perl/patchlevel.h b/gnu/usr.bin/perl/patchlevel.h index 9c22d8bb08c..0763670d77c 100644 --- a/gnu/usr.bin/perl/patchlevel.h +++ b/gnu/usr.bin/perl/patchlevel.h @@ -15,7 +15,7 @@ #define PERL_REVISION 5 /* age */ #define PERL_VERSION 8 /* epoch */ -#define PERL_SUBVERSION 5 /* generation */ +#define PERL_SUBVERSION 6 /* generation */ /* The following numbers describe the earliest compatible version of Perl ("compatibility" here being defined as sufficient binary/API @@ -119,7 +119,7 @@ hunk. #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { - NULL + NULL ,NULL }; diff --git a/gnu/usr.bin/perl/perl.c b/gnu/usr.bin/perl/perl.c index 2078eeb46b3..4cc634746a4 100644 --- a/gnu/usr.bin/perl/perl.c +++ b/gnu/usr.bin/perl/perl.c @@ -12,6 +12,12 @@ * "A ship then new they built for him/of mithril and of elven glass" --Bilbo */ +/* This file contains the top-level functions that are used to create, use + * and destroy a perl interpreter, plus the functions used by XS code to + * call back into perl. Note that it does not contain the actual main() + * function of the interpreter; that can be found in perlmain.c + */ + /* PSz 12 Nov 03 * * Be proud that perl(1) may proclaim: @@ -201,8 +207,7 @@ perl_alloc(void) my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter)); INIT_TLS_AND_INTERP; - Zero(my_perl, 1, PerlInterpreter); - return my_perl; + return ZeroD(my_perl, 1, PerlInterpreter); } #endif /* PERL_IMPLICIT_SYS */ @@ -270,11 +275,15 @@ perl_construct(pTHXx) SvREFCNT(&PL_sv_undef) = (~(U32)0)/2; sv_setpv(&PL_sv_no,PL_No); + /* value lookup in void context - happens to have the side effect + of caching the numeric forms. */ + SvIV(&PL_sv_no); SvNV(&PL_sv_no); SvREADONLY_on(&PL_sv_no); SvREFCNT(&PL_sv_no) = (~(U32)0)/2; sv_setpv(&PL_sv_yes,PL_Yes); + SvIV(&PL_sv_yes); SvNV(&PL_sv_yes); SvREADONLY_on(&PL_sv_yes); SvREFCNT(&PL_sv_yes) = (~(U32)0)/2; @@ -590,7 +599,7 @@ perl_destruct(pTHXx) */ #ifndef PERL_MICRO #if defined(USE_ENVIRON_ARRAY) && !defined(PERL_USE_SAFE_PUTENV) - if (environ != PL_origenviron + if (environ != PL_origenviron && !PL_use_safe_putenv #ifdef USE_ITHREADS /* only main thread can free environ[0] contents */ && PL_curinterp == aTHX @@ -610,6 +619,9 @@ perl_destruct(pTHXx) #endif #endif /* !PERL_MICRO */ + /* reset so print() ends up where we expect */ + setdefout(Nullgv); + #ifdef USE_ITHREADS /* the syntax tree is shared between clones * so op_free(PL_main_root) only ReREFCNT_dec's @@ -750,9 +762,6 @@ perl_destruct(pTHXx) PL_dbargs = Nullav; PL_debstash = Nullhv; - /* reset so print() ends up where we expect */ - setdefout(Nullgv); - SvREFCNT_dec(PL_argvout_stack); PL_argvout_stack = Nullav; @@ -959,9 +968,10 @@ perl_destruct(pTHXx) svend = &sva[SvREFCNT(sva)]; for (sv = sva + 1; sv < svend; ++sv) { if (SvTYPE(sv) != SVTYPEMASK) { - PerlIO_printf(Perl_debug_log, "leaked: 0x%p" - pTHX__FORMAT "\n", - sv pTHX__VALUE); + PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p" + " flags=0x08%"UVxf + " refcnt=%"UVuf pTHX__FORMAT "\n", + sv, sv->sv_flags, sv->sv_refcnt pTHX__VALUE); } } } @@ -1050,7 +1060,7 @@ perl_destruct(pTHXx) } } /* we know that type >= SVt_PV */ - (void)SvOOK_off(PL_mess_sv); + SvOOK_off(PL_mess_sv); Safefree(SvPVX(PL_mess_sv)); Safefree(SvANY(PL_mess_sv)); Safefree(PL_mess_sv); @@ -2339,6 +2349,10 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_body), (OP*)&myop, TRUE); #else + /* fail now; otherwise we could fail after the JMPENV_PUSH but + * before a PUSHEVAL, which corrupts the stack after a croak */ + TAINT_PROPER("eval_sv()"); + JMPENV_PUSH(ret); #endif switch (ret) { @@ -2510,10 +2524,16 @@ NULL int Perl_get_debug_opts(pTHX_ char **s) { + return get_debug_opts_flags(s, 1); +} + +int +Perl_get_debug_opts_flags(pTHX_ char **s, int flags) +{ static char *usage_msgd[] = { " Debugging flag values: (see also -d)", " p Tokenizing and parsing (with v, displays parse stack)", - " s Stack snapshots. with v, displays all stacks", + " s Stack snapshots (with v, displays all stacks)", " l Context (loop) stack processing", " t Trace execution", " o Method and overloading resolution", @@ -2523,7 +2543,7 @@ Perl_get_debug_opts(pTHX_ char **s) " f Format processing", " r Regular expression parsing and execution", " x Syntax tree dump", - " u Tainting checks (Obsolete, previously used for LEAKTEST)", + " u Tainting checks", " H Hash dump -- usurps values()", " X Scratchpad allocation", " D Cleaning up", @@ -2534,7 +2554,7 @@ Perl_get_debug_opts(pTHX_ char **s) " v Verbose: use in conjunction with other flags", " C Copy On Write", " A Consistency checks on internal structures", - " q quiet - currently only suppressed the 'EXECUTING' message", + " q quiet - currently only suppresses the 'EXECUTING' message", NULL }; int i = 0; @@ -2555,7 +2575,8 @@ Perl_get_debug_opts(pTHX_ char **s) i = atoi(*s); for (; isALNUM(**s); (*s)++) ; } - else { + else if (flags & 1) { + /* Give help. */ char **p = usage_msgd; while (*p) PerlIO_printf(PerlIO_stdout(), "%s\n", *p++); } @@ -2639,6 +2660,13 @@ Perl_moreswitches(pTHX_ char *s) case 'd': forbid_setid("-d"); s++; + + /* -dt indicates to the debugger that threads will be used */ + if (*s == 't' && !isALNUM(s[1])) { + ++s; + my_setenv("PERL5DB_THREADED", "1"); + } + /* The following permits -d:Mod to accepts arguments following an = in the fashion that -MSome::Mod does. */ if (*s == ':' || *s == '=') { @@ -2669,7 +2697,7 @@ Perl_moreswitches(pTHX_ char *s) #ifdef DEBUGGING forbid_setid("-D"); s++; - PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG; + PL_debug = get_debug_opts_flags(&s, 1) | DEBUG_TOP_FLAG; #else /* !DEBUGGING */ if (ckWARN_d(WARN_DEBUGGING)) Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), @@ -2786,7 +2814,7 @@ Perl_moreswitches(pTHX_ char *s) av_push(PL_preambleav, sv); } else - Perl_croak(aTHX_ "No space allowed after -%c", *(s-1)); + Perl_croak(aTHX_ "Missing argument to -%c", *(s-1)); return s; case 'n': PL_minus_n = TRUE; @@ -2919,7 +2947,7 @@ Perl may be copied only under the terms of either the Artistic License or the\n\ GNU General Public License, which may be found in the Perl 5 source kit.\n\n\ Complete documentation for Perl, including FAQ lists, should be found on\n\ this system using `man perl' or `perldoc perl'. If you have access to the\n\ -Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n"); +Internet, point your browser at http://www.perl.org/, the Perl Home Page.\n\n"); my_exit(0); case 'w': if (! (PL_dowarn & G_WARN_ALL_MASK)) @@ -3240,9 +3268,8 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv) #endif /* IAMSUID */ if (!PL_rsfp) { /* PSz 16 Sep 03 Keep neat error message */ - Perl_croak(aTHX_ "Can't open perl script \"%s\": %s%s\n", - CopFILE(PL_curcop), Strerror(errno), - ".\nUse -S to search $PATH for it."); + Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", + CopFILE(PL_curcop), Strerror(errno)); } } @@ -4218,9 +4245,10 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register { environ[0] = Nullch; } - if (env) + if (env) { + char** origenv = environ; for (; *env; env++) { - if (!(s = strchr(*env,'='))) + if (!(s = strchr(*env,'=')) || s == *env) continue; #if defined(MSDOS) && !defined(DJGPP) *s = '\0'; @@ -4231,7 +4259,13 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register (void)hv_store(hv, *env, s - *env, sv, 0); if (env != environ) mg_set(sv); + if (origenv != environ) { + /* realloc has shifted us */ + env = (env - origenv) + environ; + origenv = environ; + } } + } #endif /* USE_ENVIRON_ARRAY */ #endif /* !PERL_MICRO */ } diff --git a/gnu/usr.bin/perl/perl.h b/gnu/usr.bin/perl/perl.h index 037aa069718..f33d66e40f6 100644 --- a/gnu/usr.bin/perl/perl.h +++ b/gnu/usr.bin/perl/perl.h @@ -535,7 +535,7 @@ int usleep(unsigned int); # define MALLOC_CHECK_TAINT(argc,argv,env) #endif /* MYMALLOC */ -#define TOO_LATE_FOR_(ch,s) Perl_croak(aTHX_ "Too late for \"-%c\" option%s", (char)(ch), s) +#define TOO_LATE_FOR_(ch,s) Perl_croak(aTHX_ "\"-%c\" is on the #! line, it must also be used on the command line", (char)(ch), s) #define TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, "") #define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}") #define MALLOC_CHECK_TAINT2(argc,argv) MALLOC_CHECK_TAINT(argc,argv,NULL) @@ -4188,6 +4188,13 @@ typedef struct am_table_short AMTS; Zero(my_cxtp, 1, my_cxt_t); \ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) +/* Clones the per-interpreter data. */ +#define MY_CXT_CLONE \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ + Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) + /* This macro must be used to access members of the my_cxt_t structure. * e.g. MYCXT.some_data */ #define MY_CXT (*my_cxtp) @@ -4207,6 +4214,7 @@ typedef struct am_table_short AMTS; #define dMY_CXT_SV dNOOP #define dMY_CXT dNOOP #define MY_CXT_INIT NOOP +#define MY_CXT_CLONE NOOP #define MY_CXT my_cxt #define pMY_CXT void diff --git a/gnu/usr.bin/perl/perlio.c b/gnu/usr.bin/perl/perlio.c index 2be59ebc456..91a95439f14 100644 --- a/gnu/usr.bin/perl/perlio.c +++ b/gnu/usr.bin/perl/perlio.c @@ -9,6 +9,12 @@ * over passes, and through long dales, and across many streams. */ +/* This file contains the functions needed to implement PerlIO, which + * is Perl's private replacement for the C stdio library. This is used + * by default unless you compile with -Uuseperlio or run with + * PERLIO=:stdio (but don't do this unless you know what you're doing) + */ + /* * If we have ActivePerl-like PERL_IMPLICIT_SYS then we need a dTHX to get * at the dispatch tables, even when we do not need it for other reasons. diff --git a/gnu/usr.bin/perl/perlio.h b/gnu/usr.bin/perl/perlio.h index dd1e3d51a09..adea6b74fe3 100644 --- a/gnu/usr.bin/perl/perlio.h +++ b/gnu/usr.bin/perl/perlio.h @@ -12,7 +12,7 @@ #define _PERLIO_H /* Interface for perl to IO functions. - There is a hierachy of Configure determined #define controls: + There is a hierarchy of Configure determined #define controls: USE_STDIO - forces PerlIO_xxx() to be #define-d onto stdio functions. This is used for x2p subdirectory and for conservative builds - "just like perl5.00X used to be". diff --git a/gnu/usr.bin/perl/perly.y b/gnu/usr.bin/perl/perly.y index 3325e5e24b3..ccff774ef95 100644 --- a/gnu/usr.bin/perl/perly.y +++ b/gnu/usr.bin/perl/perly.y @@ -12,6 +12,15 @@ * All that is gold does not glitter, not all those who wander are lost.' */ +/* This file holds the grammar for the Perl language. If edited, you need + * to run regen_perly.pl, which re-creates the files perly.h, perly.tab + * and perly.act which are derived from this. + * + * The main job of of this grammar is to call the various newFOO() + * functions in op.c to build a syntax tree of OP structs. + * It relies on the lexer in toke.c to do the tokenizing. + */ + %{ #include "EXTERN.h" #define PERL_IN_PERLY_C diff --git a/gnu/usr.bin/perl/plan9/config.plan9 b/gnu/usr.bin/perl/plan9/config.plan9 index d1a3de52da7..bfb70257d47 100644 --- a/gnu/usr.bin/perl/plan9/config.plan9 +++ b/gnu/usr.bin/perl/plan9/config.plan9 @@ -3357,8 +3357,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "/sys/lib/perl/5.8.5" /**/ -#define PRIVLIB_EXP "/sys/lib/perl/5.8.5" /**/ +#define PRIVLIB "/sys/lib/perl/5.8.6" /**/ +#define PRIVLIB_EXP "/sys/lib/perl/5.8.6" /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -3485,9 +3485,9 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "/sys/lib/perl/5.8.5/site_perl" /**/ -#define SITELIB_EXP "/sys/lib/perl/5.8.5/site_perl" /**/ -#define SITELIB_STEM "/sys/lib/perl/5.8.5/site_perl" /**/ +#define SITELIB "/sys/lib/perl/5.8.6/site_perl" /**/ +#define SITELIB_EXP "/sys/lib/perl/5.8.6/site_perl" /**/ +#define SITELIB_STEM "/sys/lib/perl/5.8.6/site_perl" /**/ /* Size_t_size: * This symbol holds the size of a Size_t in bytes. diff --git a/gnu/usr.bin/perl/pod/buildtoc b/gnu/usr.bin/perl/pod/buildtoc index 86d5ba7ebf7..e4dc82ade3f 100644 --- a/gnu/usr.bin/perl/pod/buildtoc +++ b/gnu/usr.bin/perl/pod/buildtoc @@ -32,6 +32,7 @@ $masterpodfile = File::Spec->catdir($Up, "pod.lst"); dmake => File::Spec->catdir($Up, "win32", "makefile.mk"), podmak => File::Spec->catdir($Up, "win32", "pod.mak"), # plan9 => File::Spec->catdir($Up, "plan9", "mkfile"), + unix => File::Spec->catdir($Up, "Makefile.SH"), ); { @@ -673,6 +674,27 @@ sub do_vms { $makefile; } +sub do_unix { + my $name = shift; + my $makefile_SH = join '', @_; + die "$0: $name contains NUL bytes" if $makefile_SH =~ /\0/; + + $makefile_SH =~ s/\n\s+-\@test -f \S+ && cd pod && \$\(LNS\) \S+ \S+ && cd \.\. && echo "\S+" >> extra.pods \# See buildtoc\n/\0/gm; + + my $sections = () = $makefile_SH =~ m/\0+/g; + + die "$0: $name contains no copy rules" if $sections < 1; + die "$0: $name contains $sections discontigous copy rules" + if $sections > 1; + + my @copy_rules = map "\t-\@test -f pod/$Copies{$_} && cd pod && \$(LNS) $Copies{$_} $_ && cd .. && echo \"pod/$_\" >> extra.pods # See buildtoc", + keys %Copies; + + $makefile_SH =~ s/\0+/join "\n", '', @copy_rules, ''/se; + $makefile_SH; + +} + # Do stuff my $built; diff --git a/gnu/usr.bin/perl/pod/perl.pod b/gnu/usr.bin/perl/pod/perl.pod index 5b50092761d..ab9064beb0f 100644 --- a/gnu/usr.bin/perl/pod/perl.pod +++ b/gnu/usr.bin/perl/pod/perl.pod @@ -132,6 +132,7 @@ For ease of access, the Perl manual has been split up into several sections. perlhist Perl history records perldelta Perl changes since previous version + perl585delta Perl changes in version 5.8.5 perl584delta Perl changes in version 5.8.4 perl583delta Perl changes in version 5.8.3 perl582delta Perl changes in version 5.8.2 @@ -370,9 +371,10 @@ Perl developers, please write to perl-thanks@perl.org . a2p awk to perl translator s2p sed to perl translator - http://www.perl.com/ the Perl Home Page + http://www.perl.org/ the Perl homepage + http://www.perl.com/ Perl articles (O'Reilly Media) http://www.cpan.org/ the Comprehensive Perl Archive - http://www.perl.org/ Perl Mongers (Perl user groups) + http://www.pm.org/ the Perl Mongers =head1 DIAGNOSTICS diff --git a/gnu/usr.bin/perl/pod/perl58delta.pod b/gnu/usr.bin/perl/pod/perl58delta.pod index 1260c0b88c9..04a03747aac 100644 --- a/gnu/usr.bin/perl/pod/perl58delta.pod +++ b/gnu/usr.bin/perl/pod/perl58delta.pod @@ -2992,7 +2992,7 @@ Using splice() past the end of an array now causes a warning. =item * Malformed Unicode encodings (UTF-8 and UTF-16) cause a lot of warnings, -ad doestrying to use UTF-16 surrogates (which are unimplemented). +as does trying to use UTF-16 surrogates (which are unimplemented). =item * diff --git a/gnu/usr.bin/perl/pod/perlapio.pod b/gnu/usr.bin/perl/pod/perlapio.pod index 10b8dc554e0..1dc3d5396a0 100644 --- a/gnu/usr.bin/perl/pod/perlapio.pod +++ b/gnu/usr.bin/perl/pod/perlapio.pod @@ -225,7 +225,7 @@ This corresponds to clearerr(), i.e., clears 'error' and (usually) This corresponds to fflush(). Sends any buffered write data to the underlying file. If called with C<NULL> this may flush all open -streams (or core dump with some USE_STDIO implementattions). Calling +streams (or core dump with some USE_STDIO implementations). Calling on a handle open for read only, or on which last operation was a read of some kind may lead to undefined behaviour on some USE_STDIO implementations. The USE_PERLIO (layers) implementation tries to diff --git a/gnu/usr.bin/perl/pod/perlcall.pod b/gnu/usr.bin/perl/pod/perlcall.pod index 40f1d65a7be..dd520afcaa1 100644 --- a/gnu/usr.bin/perl/pod/perlcall.pod +++ b/gnu/usr.bin/perl/pod/perlcall.pod @@ -343,7 +343,11 @@ has no effect when G_EVAL is not used. When G_KEEPERR is used, any errors in the called code will be prefixed with the string "\t(in cleanup)", and appended to the current value -of C<$@>. +of C<$@>. an error will not be appended if that same error string is +already at the end of C<$@>. + +In addition, a warning is generated using the appended string. This can be +disabled using C<no warnings 'misc'>. The G_KEEPERR flag was introduced in Perl version 5.002. diff --git a/gnu/usr.bin/perl/pod/perldata.pod b/gnu/usr.bin/perl/pod/perldata.pod index 6264cf4eb00..8e0f6ca8ad0 100644 --- a/gnu/usr.bin/perl/pod/perldata.pod +++ b/gnu/usr.bin/perl/pod/perldata.pod @@ -631,7 +631,7 @@ of how to arrange for an output ordering. =head2 Subscripts -An array is subscripted by specifying a dollary sign (C<$>), then the +An array is subscripted by specifying a dollar sign (C<$>), then the name of the array (without the leading C<@>), then the subscript inside square brackets. For example: diff --git a/gnu/usr.bin/perl/pod/perldebug.pod b/gnu/usr.bin/perl/pod/perldebug.pod index e44eaafdcb0..69346524ad9 100644 --- a/gnu/usr.bin/perl/pod/perldebug.pod +++ b/gnu/usr.bin/perl/pod/perldebug.pod @@ -1014,6 +1014,12 @@ L<Dumpvalue>, and L<perlrun>. +When debugging a script that uses #! and is thus normally found in +$PATH, the -S option causes perl to search $PATH for it, so you don't +have to type the path or `which $scriptname`. + + $ perl -Sd foo.pl + =head1 BUGS You cannot get stack frame information or in any fashion debug functions diff --git a/gnu/usr.bin/perl/pod/perldiag.pod b/gnu/usr.bin/perl/pod/perldiag.pod index 7ffda4b0052..27ac73b729f 100644 --- a/gnu/usr.bin/perl/pod/perldiag.pod +++ b/gnu/usr.bin/perl/pod/perldiag.pod @@ -783,6 +783,16 @@ usually double the curlies to get the same effect though, because the inner curlies will be considered a block that loops once. See L<perlfunc/last>. +=item Can't load '%s' for module %s + +(F) The module you tried to load failed to load a dynamic extension. This +may either mean that you upgraded your version of perl to one that is +incompatible with your old dynamic extensions (which is known to happen +between major versions of perl), or (more likely) that your dynamic +extension was built against an older version of the library that is +installed on your system. You may need to rebuild your old dynamic +extensions. + =item Can't localize lexical variable %s (F) You used local on a variable name that was previously declared as a @@ -821,6 +831,12 @@ autoload, but there is no function to autoload. Most probable causes are a misprint in a function/method name or a failure to C<AutoSplit> the file, say, by doing C<make install>. +=item Can't locate loadable object for module %s in @INC + +(F) The module you loaded is trying to load an external library, like +for example, C<foo.so> or C<bar.dll>, but the L<DynaLoader> module was +unable to locate this library. See L<DynaLoader>. + =item Can't locate object method "%s" via package "%s" (F) You called a method correctly, and it correctly indicated a package @@ -924,6 +940,10 @@ for stdout. (F) The script you specified can't be opened for the indicated reason. +If you're debugging a script that uses #!, and normally relies on the +shell's $PATH search, the -S option causes perl to do that search, so +you don't have to type the path or C<`which $scriptname`>. + =item Can't read CRTL environ (S) A warning peculiar to VMS. Perl tried to read an element of %ENV @@ -1795,7 +1815,8 @@ L<perlsec> for more information. (F) You can't use system(), exec(), or a piped open in a setuid or setgid script if C<$ENV{PATH}> contains a directory that is writable by -the world. See L<perlsec>. +the world. Also, the PATH must not contain any relative directory. +See L<perlsec>. =item Insecure $ENV{%s} while running %s @@ -2016,7 +2037,7 @@ when the function is called. =item Malformed UTF-8 character (%s) -Perl detected something that didn't comply with UTF-8 encoding rules. +(W utf8) Perl detected something that didn't comply with UTF-8 encoding rules. One possible cause is that you read in data that you thought to be in UTF-8 but it wasn't (it was for example legacy 8-bit data). Another @@ -2066,6 +2087,11 @@ ended earlier on the current line. (W syntax) An underscore (underbar) in a numeric constant did not separate two digits. +=item Missing argument to -%c + +(F) The argument to the indicated command line switch must follow +immediately after the switch, without intervening spaces. + =item Missing %sbrace%s on \N{} (F) Wrong syntax of character name literal C<\N{charname}> within @@ -2363,11 +2389,6 @@ your system. (F) Configure didn't find anything resembling the setreuid() call for your system. -=item No space allowed after -%c - -(F) The argument to the indicated command line switch must follow -immediately after the switch, without intervening spaces. - =item No %s specified for -%c (F) The indicated command line switch needs a mandatory argument, but @@ -2604,6 +2625,11 @@ C<limit datasize n> (where C<n> is the number of kilobytes) to check the current limits and change them, and in ksh/bash/zsh use C<ulimit -a> and C<ulimit -d n>, respectively. +=item Out of memory during %s extend + +(X) An attempt was made to extend an array, a list, or a string beyond +the largest possible memory allocation. + =item Out of memory during "large" request for %s (F) The malloc() function returned 0, indicating there was insufficient @@ -2611,11 +2637,6 @@ remaining memory (or virtual memory) to satisfy the request. However, the request was judged large enough (compile-time default is 64K), so a possibility to shut down by trapping this error is granted. -=item Out of memory during %s extend - -(X) An attempt was made to extend an array, a list, or a string beyond -the largest possible memory allocation. - =item Out of memory during request for %s (X|F) The malloc() function returned 0, indicating there was @@ -3703,17 +3724,27 @@ target of the change to are deprecated and one should use the new ithreads instead, see L<perl58delta> for more details. -=item Tied variable freed while still in use - -(F) An access method for a tied variable (e.g. FETCH) did something to -free the variable. Since continuing the current operation is likely -to result in a coredump, Perl is bailing out instead. - =item times not implemented (F) Your version of the C library apparently doesn't do times(). I suspect you're not running on Unix. +=item "-T" is on the #! line, it must also be used on the command line + +(X) The #! line (or local equivalent) in a Perl script contains the +B<-T> option, but Perl was not invoked with B<-T> in its command line. +This is an error because, by the time Perl discovers a B<-T> in a +script, it's too late to properly taint everything from the environment. +So Perl gives up. + +If the Perl script is being executed as a command using the #! +mechanism (or its local equivalent), this error can usually be fixed by +editing the #! line so that the B<-T> option is a part of Perl's first +argument: e.g. change C<perl -n -T> to C<perl -T -n>. + +If the Perl script is being executed as C<perl scriptname>, then the +B<-T> option must appear on the command line: C<perl -T scriptname>. + =item To%s: illegal mapping '%s' (F) You tried to define a customized To-mapping for lc(), lcfirst, @@ -3736,22 +3767,6 @@ system call to call, silly dilly. B<-M> or B<-m> option. This is an error because B<-M> and B<-m> options are not intended for use inside scripts. Use the C<use> pragma instead. -=item Too late for "B<-T>" option - -(X) The #! line (or local equivalent) in a Perl script contains the -B<-T> option, but Perl was not invoked with B<-T> in its command line. -This is an error because, by the time Perl discovers a B<-T> in a -script, it's too late to properly taint everything from the environment. -So Perl gives up. - -If the Perl script is being executed as a command using the #! -mechanism (or its local equivalent), this error can usually be fixed by -editing the #! line so that the B<-T> option is a part of Perl's first -argument: e.g. change C<perl -n -T> to C<perl -T -n>. - -If the Perl script is being executed as C<perl scriptname>, then the -B<-T> option must appear on the command line: C<perl -T scriptname>. - =item Too late to run %s block (W void) A CHECK or INIT block is being defined during run time proper, diff --git a/gnu/usr.bin/perl/pod/perlfaq.pod b/gnu/usr.bin/perl/pod/perlfaq.pod index 7acdf613d04..1b5760e342f 100644 --- a/gnu/usr.bin/perl/pod/perlfaq.pod +++ b/gnu/usr.bin/perl/pod/perlfaq.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq - frequently asked questions about Perl ($Date: 2003/01/31 17:37:17 $) +perlfaq - frequently asked questions about Perl ($Date: 2003/12/03 03:02:44 $) =head1 DESCRIPTION @@ -98,6 +98,7 @@ in respect of this information or its use. =head1 The Questions + =head2 L<perlfaq1>: General Questions About Perl Very general, high-level questions about Perl. @@ -122,6 +123,10 @@ What are perl4 and perl5? =item * +What is Ponie? + +=item * + What is perl6? =item * @@ -169,8 +174,7 @@ How can I convince my sysadmin/supervisor/employees to use version 5/5.6.1/Perl =head2 L<perlfaq2>: Obtaining and Learning about Perl -Where to find source and documentation for Perl, support, -and related matters. +Where to find source and documentation for Perl, support, and related matters. =over 4 @@ -374,7 +378,6 @@ Where can I learn about linking C with Perl? [h2xs, xsubpp] =item * I've read perlembed, perlguts, etc., but I can't embed perl in -my C program; what am I doing wrong? =item * @@ -389,8 +392,7 @@ What's MakeMaker? =head2 L<perlfaq4>: Data Manipulation -Manipulating numbers, dates, strings, arrays, hashes, and -miscellaneous data issues. +Manipulating numbers, dates, strings, arrays, hashes, and miscellaneous data issues. =over 4 @@ -400,6 +402,10 @@ Why am I getting long decimals (eg, 19.9499999999999) instead of the numbers I s =item * +Why is int() broken? + +=item * + Why isn't my octal data interpreted correctly? =item * @@ -408,7 +414,7 @@ Does Perl have a round() function? What about ceil() and floor()? Trig functio =item * -How do I convert between numeric representations? +How do I convert between numeric representations/bases/radixes? =item * @@ -833,7 +839,7 @@ How do I close a file descriptor by number? =item * -Why can't I use "C:\temp\foo" in DOS paths? What doesn't `C:\temp\foo.exe` work? +Why can't I use "C:\temp\foo" in DOS paths? Why doesn't `C:\temp\foo.exe` work? =item * @@ -856,7 +862,7 @@ Why do I get weird spaces when I print an array of lines? =head2 L<perlfaq6>: Regular Expressions -Pattern matching and regular expressions. +This section is surprisingly small because the rest of the FAQ is littered with answers involving regular expressions. For example, decoding a URL and checking whether something is a number are handled with regular expressions, but those answers are found elsewhere in this document (in L<perlfaq9>: ``How do I decode or create those %-encodings on the web'' and L<perlfaq4>: ``How do I determine whether a scalar is a number/whole/integer/float'', to be precise). =over 4 @@ -942,7 +948,7 @@ Are Perl regexes DFAs or NFAs? Are they POSIX compliant? =item * -What's wrong with using grep or map in a void context? +What's wrong with using grep in a void context? =item * @@ -957,8 +963,7 @@ How do I match a pattern that is supplied by the user? =head2 L<perlfaq7>: General Perl Language Issues -General Perl language issues that don't clearly fit into any of the -other sections. +General Perl language issues that don't clearly fit into any of the other sections. =over 4 @@ -1083,8 +1088,7 @@ What does "bad interpreter" mean? =head2 L<perlfaq8>: System Interaction -Interprocess communication (IPC), control over the user-interface -(keyboard, screen and pointing devices). +This section of the Perl FAQ covers questions involving operating system interaction. Topics include interprocess communication (IPC), control over the user-interface (keyboard, screen and pointing devices), and most anything else not related to data manipulation. Read the FAQs and documentation specific to the port of perl to your operating system (eg, L<perlvms>, L<perlplan9>, ...). These should contain more detailed information on the vagaries of your perl. =over 4 @@ -1262,6 +1266,10 @@ How do I open a file without blocking? =item * +How do I tell the difference between errors from the shell and perl? + +=item * + How do I install a module from CPAN? =item * @@ -1278,7 +1286,7 @@ How do I add the directory my program lives in to the module/library search path =item * -How do I add a directory to my include path at runtime? +How do I add a directory to my include path (@INC) at runtime? =item * diff --git a/gnu/usr.bin/perl/pod/perlfaq1.pod b/gnu/usr.bin/perl/pod/perlfaq1.pod index e868e2e7600..c4aa4cc455a 100644 --- a/gnu/usr.bin/perl/pod/perlfaq1.pod +++ b/gnu/usr.bin/perl/pod/perlfaq1.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq1 - General Questions About Perl ($Revision: 1.6 $, $Date: 2003/12/03 03:02:44 $) +perlfaq1 - General Questions About Perl ($Revision: 1.7 $, $Date: 2004/04/07 21:33:08 $) =head1 DESCRIPTION @@ -173,7 +173,7 @@ Probably the best thing to do is try to write equivalent code to do a set of tasks. These languages have their own newsgroups in which you can learn about (but hopefully not argue about) them. -Some comparison documents can be found at http://language.perl.com/versus/ +Some comparison documents can be found at http://www.perl.com/doc/FMTEYEWTK/versus/ if you really can't stop yourself. =head2 Can I do [task] in Perl? diff --git a/gnu/usr.bin/perl/pod/perlfaq2.pod b/gnu/usr.bin/perl/pod/perlfaq2.pod index 929a8b64a92..89ed6b7fa38 100644 --- a/gnu/usr.bin/perl/pod/perlfaq2.pod +++ b/gnu/usr.bin/perl/pod/perlfaq2.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.6 $, $Date: 2003/12/03 03:02:44 $) +perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.7 $, $Date: 2004/04/07 21:33:08 $) =head1 DESCRIPTION @@ -129,7 +129,7 @@ miscellaneous modules. See http://www.cpan.org/modules/00modlist.long.html or http://search.cpan.org/ for a more complete list of modules by category. -CPAN is not affiliated with O'Reilly and Associates. +CPAN is not affiliated with O'Reilly Media. =head2 Is there an ISO or ANSI certified version of Perl? @@ -218,34 +218,34 @@ This is faster and more productive than just posting a request. =head2 Perl Books -A number of books on Perl and/or CGI programming are available. A few of -these are good, some are OK, but many aren't worth your money. Tom -Christiansen maintains a list of these books, some with extensive -reviews, at http://www.perl.com/perl/critiques/index.html . +A number of books on Perl and/or CGI programming are available. A few +of these are good, some are OK, but many aren't worth your money. +There is a list of these books, some with extensive reviews, at +http://books.perl.org/ . The incontestably definitive reference book on Perl, written by -the creator of Perl, is now (July 2000) in its third edition: +the creator of Perl, is now (Sept 2004) in its third edition: - Programming Perl (the "Camel Book"): + Programming Perl (the "Camel Book"): by Larry Wall, Tom Christiansen, and Jon Orwant - 0-596-00027-8 [3rd edition July 2000] + ISBN 0-596-00027-8 [3rd edition July 2000] http://www.oreilly.com/catalog/pperl3/ - (English, translations to several languages are also available) + (English, translations to several languages are also available) The companion volume to the Camel containing thousands of real-world examples, mini-tutorials, and complete programs is: - The Perl Cookbook (the "Ram Book"): + The Perl Cookbook (the "Ram Book"): by Tom Christiansen and Nathan Torkington, with Foreword by Larry Wall - ISBN 1-56592-243-3 [1st Edition August 1998] - http://perl.oreilly.com/catalog/cookbook/ + ISBN 0-596-00313-7 [2nd Edition August 2003] + http://www.oreilly.com/catalog/perlckbk2/ If you're already a seasoned programmer, then the Camel Book might suffice for you to learn Perl from. If you're not, check out the Llama book: - Learning Perl (the "Llama Book") + Learning Perl (the "Llama Book") by Randal L. Schwartz and Tom Phoenix ISBN 0-596-00132-0 [3rd edition July 2001] http://www.oreilly.com/catalog/lperl3/ @@ -254,26 +254,26 @@ And for more advanced information on writing larger programs, presented in the same style as the Llama book, continue your education with the Alpaca book: - Learning Perl Objects, References, and Modules (the "Alpaca Book") - by Randal L. Schwartz, with Tom Phoenix (foreword by Damian Conway) - ISBN 0-596-00478-8 [1st edition June 2003] - http://www.oreilly.com/catalog/lrnperlorm/ + Learning Perl Objects, References, and Modules (the "Alpaca Book") + by Randal L. Schwartz, with Tom Phoenix (foreword by Damian Conway) + ISBN 0-596-00478-8 [1st edition June 2003] + http://www.oreilly.com/catalog/lrnperlorm/ If you're not an accidental programmer, but a more serious and possibly even degreed computer scientist who doesn't need as much hand-holding as we try to provide in the Llama, please check out the delightful book - Perl: The Programmer's Companion - by Nigel Chapman - ISBN 0-471-97563-X [1997, 3rd printing Spring 1998] - http://www.wiley.com/compbooks/catalog/97563-X.htm - http://www.wiley.com/compbooks/chapman/perl/perltpc.html (errata etc) + Perl: The Programmer's Companion + by Nigel Chapman + ISBN 0-471-97563-X [1997, 3rd printing Spring 1998] + http://www.wiley.com/compbooks/catalog/97563-X.htm + http://www.wiley.com/compbooks/chapman/perl/perltpc.html (errata etc) If you are more at home in Windows the following is available (though unfortunately rather dated). - Learning Perl on Win32 Systems (the "Gecko Book") + Learning Perl on Win32 Systems (the "Gecko Book") by Randal L. Schwartz, Erik Olson, and Tom Christiansen, with foreword by Larry Wall ISBN 1-56592-324-3 [1st edition August 1997] @@ -296,56 +296,56 @@ Recommended books on (or mostly on) Perl follow. =item References - Programming Perl + Programming Perl by Larry Wall, Tom Christiansen, and Jon Orwant ISBN 0-596-00027-8 [3rd edition July 2000] http://www.oreilly.com/catalog/pperl3/ - Perl 5 Pocket Reference - by Johan Vromans + Perl 5 Pocket Reference + by Johan Vromans ISBN 0-596-00032-4 [3rd edition May 2000] http://www.oreilly.com/catalog/perlpr3/ - Perl in a Nutshell - by Ellen Siever, Stephan Spainhour, and Nathan Patwardhan + Perl in a Nutshell + by Ellen Siever, Stephan Spainhour, and Nathan Patwardhan ISBN 1-56592-286-7 [1st edition December 1998] http://www.oreilly.com/catalog/perlnut/ =item Tutorials - Elements of Programming with Perl + Elements of Programming with Perl by Andrew L. Johnson ISBN 1-884777-80-5 [1st edition October 1999] http://www.manning.com/Johnson/ - Learning Perl + Learning Perl by Randal L. Schwartz and Tom Phoenix ISBN 0-596-00132-0 [3rd edition July 2001] http://www.oreilly.com/catalog/lperl3/ - Learning Perl Objects, References, and Modules - by Randal L. Schwartz, with Tom Phoenix (foreword by Damian Conway) - ISBN 0-596-00478-8 [1st edition June 2003] - http://www.oreilly.com/catalog/lrnperlorm/ + Learning Perl Objects, References, and Modules + by Randal L. Schwartz, with Tom Phoenix (foreword by Damian Conway) + ISBN 0-596-00478-8 [1st edition June 2003] + http://www.oreilly.com/catalog/lrnperlorm/ - Learning Perl on Win32 Systems + Learning Perl on Win32 Systems by Randal L. Schwartz, Erik Olson, and Tom Christiansen, with foreword by Larry Wall ISBN 1-56592-324-3 [1st edition August 1997] http://www.oreilly.com/catalog/lperlwin/ - Perl: The Programmer's Companion + Perl: The Programmer's Companion by Nigel Chapman ISBN 0-471-97563-X [1997, 3rd printing Spring 1998] - http://www.wiley.com/compbooks/catalog/97563-X.htm - http://www.wiley.com/compbooks/chapman/perl/perltpc.html (errata etc) + http://www.wiley.com/compbooks/catalog/97563-X.htm + http://www.wiley.com/compbooks/chapman/perl/perltpc.html (errata etc) - Cross-Platform Perl + Cross-Platform Perl by Eric Foster-Johnson ISBN 1-55851-483-X [2nd edition September 2000] http://www.pconline.com/~erc/perlbook.htm - MacPerl: Power and Ease + MacPerl: Power and Ease by Vicki Brown and Chris Nandor, with foreword by Matthias Neeracher ISBN 1-881957-32-2 [1st edition May 1998] @@ -353,21 +353,20 @@ Recommended books on (or mostly on) Perl follow. =item Task-Oriented - The Perl Cookbook + The Perl Cookbook by Tom Christiansen and Nathan Torkington with foreword by Larry Wall ISBN 1-56592-243-3 [1st edition August 1998] http://www.oreilly.com/catalog/cookbook/ - Effective Perl Programming + Effective Perl Programming by Joseph Hall ISBN 0-201-41975-0 [1st edition 1998] http://www.awl.com/ - =item Special Topics - Mastering Regular Expressions + Mastering Regular Expressions by Jeffrey E. F. Friedl ISBN 0-596-00289-0 [2nd edition July 2002] http://www.oreilly.com/catalog/regex2/ @@ -393,10 +392,15 @@ Recommended books on (or mostly on) Perl follow. ISBN 1-56592-716-8 [1st edition January 2002] http://www.oreilly.com/catalog/mastperltk/ - Extending and Embedding Perl - by Tim Jenness and Simon Cozens - ISBN 1-930110-82-0 [1st edition August 2002] - http://www.manning.com/jenness + Extending and Embedding Perl + by Tim Jenness and Simon Cozens + ISBN 1-930110-82-0 [1st edition August 2002] + http://www.manning.com/jenness + + Perl Debugger Pocket Reference + by Richard Foley + ISBN 0-596-00503-2 [1st edition January 2004] + http://www.oreilly.com/catalog/perldebugpr/ =back @@ -476,32 +480,6 @@ as do the O'Reilly Perl Resource Kits (in both the Unix flavor and in the proprietary Microsoft flavor); the free Unix distributions also all come with Perl. -Alternatively, you can purchase commercial incidence based support -through the Perl Clinic. The following is a commercial from them: - -"The Perl Clinic is a commercial Perl support service operated by -ActiveState Tool Corp. and The Ingram Group. The operators have many -years of in-depth experience with Perl applications and Perl internals -on a wide range of platforms. - -"Through our group of highly experienced and well-trained support engineers, -we will put our best effort into understanding your problem, providing an -explanation of the situation, and a recommendation on how to proceed." - -Contact The Perl Clinic at - - www.PerlClinic.com - - North America Pacific Standard Time (GMT-8) - Tel: 1 604 606-4611 hours 8am-6pm - Fax: 1 604 606-4640 - - Europe (GMT) - Tel: 00 44 1483 862814 - Fax: 00 44 1483 862801 - -See also www.perl.com for updates on tutorials, training, and support. - =head2 Where do I send bug reports? If you are reporting a bug in the perl interpreter or the modules @@ -518,29 +496,27 @@ Read the perlbug(1) man page (perl5.004 or later) for more information. =head2 What is perl.com? Perl Mongers? pm.org? perl.org? cpan.org? -The Perl Home Page at http://www.perl.com/ is currently hosted by -The O'Reilly Network, a subsidiary of O'Reilly and Associates. +Perl.com at http://www.perl.com/ is part of the O'Reilly Network, a +subsidiary of O'Reilly Media. + +The Perl Foundation is an advocacy organization for the Perl language +which maintains the web site http://www.perl.org/ as a general +advocacy site for the Perl language. It uses the domain to provide +general support services to the Perl community, including the hosting +of mailing lists, web sites, and other services. The web site +http://www.perl.org/ is a general advocacy site for the Perl language, +and there are many other sub-domains for special topics, such as -Perl Mongers is an advocacy organization for the Perl language which -maintains the web site http://www.perl.org/ as a general advocacy -site for the Perl language. + http://learn.perl.org/ + http://use.perl.org/ + http://jobs.perl.org/ + http://lists.perl.org/ Perl Mongers uses the pm.org domain for services related to Perl user groups, including the hosting of mailing lists and web sites. See the Perl user group web site at http://www.pm.org/ for more information about joining, starting, or requesting services for a Perl user group. -Perl Mongers also maintain the perl.org domain to provide general -support services to the Perl community, including the hosting of mailing -lists, web sites, and other services. The web site -http://www.perl.org/ is a general advocacy site for the Perl language, -and there are many other sub-domains for special topics, such as - - http://bugs.perl.org/ - http://history.perl.org/ - http://lists.perl.org/ - http://use.perl.org/ - http://www.cpan.org/ is the Comprehensive Perl Archive Network, a replicated worlwide repository of Perl software, see the I<What is CPAN?> question earlier in this document. diff --git a/gnu/usr.bin/perl/pod/perlfaq3.pod b/gnu/usr.bin/perl/pod/perlfaq3.pod index 26c7b4c9843..716567d4c0e 100644 --- a/gnu/usr.bin/perl/pod/perlfaq3.pod +++ b/gnu/usr.bin/perl/pod/perlfaq3.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq3 - Programming Tools ($Revision: 1.6 $, $Date: 2003/12/03 03:02:44 $) +perlfaq3 - Programming Tools ($Revision: 1.7 $, $Date: 2004/04/07 21:33:08 $) =head1 DESCRIPTION @@ -218,24 +218,24 @@ If you're on Unix, you already have an IDE--Unix itself. The UNIX philosophy is the philosophy of several small tools that each do one thing and do it well. It's like a carpenter's toolbox. -If you want an IDE, check the following: +If you want an IDE, check the following (in alphabetical order, not +order of preference): =over 4 -=item Komodo +=item Eclipse -ActiveState's cross-platform (as of April 2001 Windows and Linux), -multi-language IDE has Perl support, including a regular expression -debugger and remote debugging -( http://www.ActiveState.com/Products/Komodo/index.html ). (Visual -Perl, a Visual Studio.NET plug-in is currently (early 2001) in beta -( http://www.ActiveState.com/Products/VisualPerl/index.html )). +The Eclipse Perl Integration Project integrates Perl +editing/debugging with Eclipse. + +The website for the project is http://e-p-i-c.sf.net/ -=item The Object System +=item Komodo -( http://www.castlelink.co.uk/object_system/ ) is a Perl web -applications development IDE, apparently for any platform -that runs Perl. +ActiveState's cross-platform (as of October 2004, that's Windows, Linux, +and Solaris), multi-language IDE has Perl support, including a regular expression +debugger and remote debugging +( http://www.ActiveState.com/Products/Komodo/ ). =item Open Perl IDE @@ -244,6 +244,11 @@ Open Perl IDE is an integrated development environment for writing and debugging Perl scripts with ActiveState's ActivePerl distribution under Windows 95/98/NT/2000. +=item OptiPerl + +( http://www.optiperl.com/ ) is a Windows IDE with simulated CGI +environment, including debugger and syntax highlighting editor. + =item PerlBuilder ( http://www.solutionsoft.com/perl.htm ) is an integrated development @@ -254,10 +259,11 @@ environment for Windows that supports Perl development. ( http://helpconsulting.net/visiperl/ ) From Help Consulting, for Windows. -=item OptiPerl +=item Visual Perl + +( http://www.activestate.com/Products/Visual_Perl/ ) +Visual Perl is a Visual Studio.NET plug-in from ActiveState. -( http://www.optiperl.com/ ) is a Windows IDE with simulated CGI -environment, including debugger and syntax highlighting editor. =back @@ -279,7 +285,7 @@ specifically for programming, such as Textpad If you are using MacOS, the same concerns apply. MacPerl (for Classic environments) comes with a simple editor. Popular external editors are BBEdit ( http://www.bbedit.com/ ) -or Alpha ( http://www.kelehers.org/alpha/ ). MacOS X users can +or Alpha ( http://www.his.com/~jguyer/Alpha/Alpha8.html ). MacOS X users can use Unix editors as well. =over 4 @@ -338,7 +344,7 @@ The following are Win32 multilanguage editor/IDESs that support Perl: =item Codewright -http://www.starbase.com/ +http://www.borland.com/codewright/ =item MultiEdit @@ -399,16 +405,22 @@ no 32k limit). =over 4 -=item BBEdit and BBEdit Lite +=item Affrus -are text editors for Mac OS that have a Perl sensitivity mode -( http://web.barebones.com/ ). +is a full Perl development enivornment with full debugger support ( +http://www.latenightsw.com ). =item Alpha is an editor, written and extensible in Tcl, that nonetheless has built in support for several popular markup and programming languages -including Perl and HTML ( http://alpha.olm.net/ ). +including Perl and HTML ( http://www.his.com/~jguyer/Alpha/Alpha8.html ). + +=item BBEdit and BBEdit Lite + +are text editors for Mac OS that have a Perl sensitivity mode +( http://web.barebones.com/ ). + =back @@ -454,7 +466,7 @@ to the Athena Widget set. Both are available from CPAN. See the directory http://www.cpan.org/modules/by-category/08_User_Interfaces/ Invaluable for Perl/Tk programming are the Perl/Tk FAQ at -http://w4.lns.cornell.edu/%7Epvhp/ptk/ptkTOC.html , the Perl/Tk Reference +http://phaseit.net/claird/comp.lang.perl.tk/ptkFAQ.html , the Perl/Tk Reference Guide available at http://www.cpan.org/authors/Stephen_O_Lidie/ , and the online manpages at @@ -780,7 +792,7 @@ Perl install anyway. =head2 How can I compile Perl into Java? You can also integrate Java and Perl with the -Perl Resource Kit from O'Reilly and Associates. See +Perl Resource Kit from O'Reilly Media. See http://www.oreilly.com/catalog/prkunix/ . Perl 5.6 comes with Java Perl Lingo, or JPL. JPL, still in diff --git a/gnu/usr.bin/perl/pod/perlfaq4.pod b/gnu/usr.bin/perl/pod/perlfaq4.pod index 2ff7c7110ef..5888b78286b 100644 --- a/gnu/usr.bin/perl/pod/perlfaq4.pod +++ b/gnu/usr.bin/perl/pod/perlfaq4.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq4 - Data Manipulation ($Revision: 1.6 $, $Date: 2003/12/03 03:02:44 $) +perlfaq4 - Data Manipulation ($Revision: 1.7 $, $Date: 2004/04/07 21:33:08 $) =head1 DESCRIPTION @@ -559,7 +559,7 @@ C<$timestamp = gmtime(1005613200)> sets $timestamp to "Tue Nov 13 01:00:00 That doesn't mean that Perl can't be used to create non-Y2K compliant programs. It can. But so can your pencil. It's the fault of the user, not the language. At the risk of inflaming the NRA: ``Perl doesn't -break Y2K, people do.'' See http://language.perl.com/news/y2k.html for +break Y2K, people do.'' See http://www.perl.org/about/y2k.html for a longer exposition. =head1 Data: Strings @@ -1715,19 +1715,15 @@ sorting the keys as shown in an earlier question. =head2 What happens if I add or remove keys from a hash while iterating over it? -Don't do that. :-) +(contributed by brian d foy) -[lwall] In Perl 4, you were not allowed to modify a hash at all while -iterating over it. In Perl 5 you can delete from it, but you still -can't add to it, because that might cause a doubling of the hash table, -in which half the entries get copied up to the new top half of the -table, at which point you've totally bamboozled the iterator code. -Even if the table doesn't double, there's no telling whether your new -entry will be inserted before or after the current iterator position. +The easy answer is "Don't do that!" -Either treasure up your changes and make them after the iterator finishes -or use keys to fetch all the old keys at once, and iterate over the list -of keys. +If you iterate through the hash with each(), you can delete the key +most recently returned without worrying about it. If you delete or add +other keys, the iterator may skip or double up on them since perl +may rearrange the hash table. See the +entry for C<each()> in L<perlfunc>. =head2 How do I look up a hash element by value? diff --git a/gnu/usr.bin/perl/pod/perlfaq6.pod b/gnu/usr.bin/perl/pod/perlfaq6.pod index 168233bd1b5..6b0aaf71828 100644 --- a/gnu/usr.bin/perl/pod/perlfaq6.pod +++ b/gnu/usr.bin/perl/pod/perlfaq6.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq6 - Regular Expressions ($Revision: 1.20 $, $Date: 2003/01/03 20:05:28 $) +perlfaq6 - Regular Expressions ($Revision: 1.6 $, $Date: 2003/12/03 03:02:44 $) =head1 DESCRIPTION @@ -151,7 +151,19 @@ Up to Perl 5.8.0, $/ has to be a string. This may change in 5.10, but don't get your hopes up. Until then, you can use these examples if you really need to do this. -Use the four argument form of sysread to continually add to +If you have File::Stream, this is easy. + + use File::Stream; + my $stream = File::Stream->new( + $filehandle, + separator => qr/\s*,\s*/, + ); + + print "$_\n" while <$stream>; + +If you don't have File::Stream, you have to do a little more work. + +You can use the four argument form of sysread to continually add to a buffer. After you add to the buffer, you check if you have a complete line (using your regular expression). @@ -354,7 +366,7 @@ created by Jeffrey Friedl and later modified by Fred Curtis. $/ = undef; $_ = <>; - s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#$2#gs + s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#defined $2 ? $2 : ""#gse; print; This could, of course, be more legibly written with the C</x> modifier, adding @@ -395,11 +407,11 @@ whitespace and comments. Here it is expanded, courtesy of Fred Curtis. . ## Anything other char [^/"'\\]* ## Chars which doesn't start a comment, string or escape ) - }{$2}gxs; + }{defined $2 ? $2 : ""}gxse; A slight modification also removes C++ comments: - s#/\*[^*]*\*+([^/*][^*]*\*+)*/|//[^\n]*|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#$2#gs; + s#/\*[^*]*\*+([^/*][^*]*\*+)*/|//[^\n]*|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#defined $2 ? $2 : ""#gse; =head2 Can I use Perl regular expressions to match balanced text? @@ -745,17 +757,17 @@ Or like this: } Here's another, slightly less painful, way to do it from Benjamin -Goldberg: +Goldberg, who uses a zero-width negative look-behind assertion. - $martian =~ m/ - (?!<[A-Z]) - (?:[A-Z][A-Z])*? - GX - /x; + print "found GX!\n" if $martian =~ m/ + (?<![A-Z]) + (?:[A-Z][A-Z])*? + GX + /x; This succeeds if the "martian" character GX is in the string, and fails -otherwise. If you don't like using (?!<), you can replace (?!<[A-Z]) -with (?:^|[^A-Z]). +otherwise. If you don't like using (?<!), a zero-width negative +look-behind assertion, you can replace (?<![A-Z]) with (?:^|[^A-Z]). It does have the drawback of putting the wrong thing in $-[0] and $+[0], but this usually can be worked around. diff --git a/gnu/usr.bin/perl/pod/perlfaq7.pod b/gnu/usr.bin/perl/pod/perlfaq7.pod index 96d6b88d4a2..2f0287def14 100644 --- a/gnu/usr.bin/perl/pod/perlfaq7.pod +++ b/gnu/usr.bin/perl/pod/perlfaq7.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq7 - General Perl Language Issues ($Revision: 1.15 $, $Date: 2003/07/24 02:17:21 $) +perlfaq7 - General Perl Language Issues ($Revision: 1.6 $, $Date: 2003/12/03 03:02:45 $) =head1 DESCRIPTION @@ -97,6 +97,16 @@ See L<perllexwarn> for more details. no warnings; # temporarily turn off warnings $a = $b + $c; # I know these might be undef } + +Additionally, you can enable and disable categories of warnings. +You turn off the categories you want to ignore and you can still +get other categories of warnings. See L<perllexwarn> for the +complete details, including the category names and hierarchy. + + { + no warnings 'uninitialized'; + $a = $b + $c; + } If you have an older version of Perl, the C<$^W> variable (documented in L<perlvar>) controls runtime warnings for a block: @@ -213,7 +223,7 @@ but encourages closures. Here's a classic function-generating function: sub add_function_generator { - return sub { shift + shift }; + return sub { shift() + shift() }; } $add_sub = add_function_generator(); @@ -232,7 +242,7 @@ value that the lexical had when the function was created. sub make_adder { my $addpiece = shift; - return sub { shift + $addpiece }; + return sub { shift() + $addpiece }; } $f1 = make_adder(20); diff --git a/gnu/usr.bin/perl/pod/perlfaq8.pod b/gnu/usr.bin/perl/pod/perlfaq8.pod index 22f6a0727c7..052ce7a001a 100644 --- a/gnu/usr.bin/perl/pod/perlfaq8.pod +++ b/gnu/usr.bin/perl/pod/perlfaq8.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq8 - System Interaction ($Revision: 1.6 $, $Date: 2003/12/03 03:02:45 $) +perlfaq8 - System Interaction ($Revision: 1.7 $, $Date: 2004/08/09 18:10:15 $) =head1 DESCRIPTION @@ -413,31 +413,30 @@ foregrounded process group, which you then trap in your process. Signals are documented in L<perlipc/"Signals"> and the section on ``Signals'' in the Camel. -Be warned that very few C libraries are re-entrant. Therefore, if you -attempt to print() in a handler that got invoked during another stdio -operation your internal structures will likely be in an -inconsistent state, and your program will dump core. You can -sometimes avoid this by using syswrite() instead of print(). +You can set the values of the %SIG hash to be the functions you want +to handle the signal. After perl catches the signal, it looks in %SIG +for a key with the same name as the signal, then calls the subroutine +value for that key. + + # as an anonymous subroutine + + $SIG{INT} = sub { syswrite(STDERR, "ouch\n", 5 ) }; + + # or a reference to a function + + $SIG{INT} = \&ouch; + + # or the name of the function as a string + + $SIG{INT} = "ouch"; + +Perl versions before 5.8 had in its C source code signal handlers which +would catch the signal and possibly run a Perl function that you had set +in %SIG. This violated the rules of signal handling at that level +causing perl to dump core. Since version 5.8.0, perl looks at %SIG +*after* the signal has been caught, rather than while it is being caught. +Previous versions of this answer were incorrect. -Unless you're exceedingly careful, the only safe things to do inside a -signal handler are (1) set a variable and (2) exit. In the first case, -you should only set a variable in such a way that malloc() is not -called (eg, by setting a variable that already has a value). - -For example: - - $Interrupted = 0; # to ensure it has a value - $SIG{INT} = sub { - $Interrupted++; - syswrite(STDERR, "ouch\n", 5); - } - -However, because syscalls restart by default, you'll find that if -you're in a "slow" call, such as <FH>, read(), connect(), or -wait(), that the only way to terminate them is by "longjumping" out; -that is, by raising an exception. See the time-out handler for a -blocking flock() in L<perlipc/"Signals"> or the section on ``Signals'' -in the Camel book. =head2 How do I modify the shadow password file on a Unix system? @@ -1066,6 +1065,74 @@ sysopen(): sysopen(FH, "/foo/somefile", O_WRONLY|O_NDELAY|O_CREAT, 0644) or die "can't open /foo/somefile: $!": +=head2 How do I tell the difference between errors from the shell and perl? + +(answer contributed by brian d foy, C<< <bdfoy@cpan.org> >> + +When you run a Perl script, something else is running the script for you, +and that something else may output error messages. The script might +emit its own warnings and error messages. Most of the time you cannot +tell who said what. + +You probably cannot fix the thing that runs perl, but you can change how +perl outputs its warnings by defining a custom warning and die functions. + +Consider this script, which has an error you may not notice immediately. + + #!/usr/locl/bin/perl + + print "Hello World\n"; + +I get an error when I run this from my shell (which happens to be +bash). That may look like perl forgot it has a print() function, +but my shebang line is not the path to perl, so the shell runs the +script, and I get the error. + + $ ./test + ./test: line 3: print: command not found + +A quick and dirty fix involves a little bit of code, but this may be all +you need to figure out the problem. + + #!/usr/bin/perl -w + + BEGIN { + $SIG{__WARN__} = sub{ print STDERR "Perl: ", @_; }; + $SIG{__DIE__} = sub{ print STDERR "Perl: ", @_; exit 1}; + } + + $a = 1 + undef; + $x / 0; + __END__ + +The perl message comes out with "Perl" in front. The BEGIN block +works at compile time so all of the compilation errors and warnings +get the "Perl:" prefix too. + + Perl: Useless use of division (/) in void context at ./test line 9. + Perl: Name "main::a" used only once: possible typo at ./test line 8. + Perl: Name "main::x" used only once: possible typo at ./test line 9. + Perl: Use of uninitialized value in addition (+) at ./test line 8. + Perl: Use of uninitialized value in division (/) at ./test line 9. + Perl: Illegal division by zero at ./test line 9. + Perl: Illegal division by zero at -e line 3. + +If I don't see that "Perl:", it's not from perl. + +You could also just know all the perl errors, and although there are +some people who may know all of them, you probably don't. However, they +all should be in the perldiag manpage. If you don't find the error in +there, it probably isn't a perl error. + +Looking up every message is not the easiest way, so let perl to do it +for you. Use the diagnostics pragma with turns perl's normal messages +into longer discussions on the topic. + + use diagnostics; + +If you don't get a paragraph or two of expanded discussion, it +might not be perl's message. + =head2 How do I install a module from CPAN? The easiest way is to have a module also named CPAN do it for you. diff --git a/gnu/usr.bin/perl/pod/perlfaq9.pod b/gnu/usr.bin/perl/pod/perlfaq9.pod index f73c619b988..c2991ccf559 100644 --- a/gnu/usr.bin/perl/pod/perlfaq9.pod +++ b/gnu/usr.bin/perl/pod/perlfaq9.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq9 - Networking ($Revision: 1.15 $, $Date: 2003/01/31 17:36:57 $) +perlfaq9 - Networking ($Revision: 1.6 $, $Date: 2003/12/03 03:02:45 $) =head1 DESCRIPTION @@ -383,7 +383,7 @@ a database, send mail, or purchase a computer). You can't, at least, not in real time. Bummer, eh? Without sending mail to the address and seeing whether there's a human -on the other hand to answer you, you cannot determine whether a mail +on the other end to answer you, you cannot determine whether a mail address is valid. Even if you apply the mail header standard, you can have problems, because there are deliverable addresses that aren't RFC-822 (the mail header standard) compliant, and addresses that aren't diff --git a/gnu/usr.bin/perl/pod/perlfunc.pod b/gnu/usr.bin/perl/pod/perlfunc.pod index fe300187e5b..7e52c4121d2 100644 --- a/gnu/usr.bin/perl/pod/perlfunc.pod +++ b/gnu/usr.bin/perl/pod/perlfunc.pod @@ -2922,7 +2922,9 @@ works for symmetry, but you really should consider writing something to the temporary file first. You will need to seek() to do the reading. -File handles can be opened to "in memory" files held in Perl scalars via: +Since v5.8.0, perl has built using PerlIO by default. Unless you've +changed this (ie Configure -Uuseperlio), you can open file handles to +"in memory" files held in Perl scalars via: open($fh, '>', \$variable) || .. @@ -2985,6 +2987,8 @@ Examples: } } +See L<perliol/> for detailed info on PerlIO. + You may also, in the Bourne shell tradition, specify an EXPR beginning with C<< '>&' >>, in which case the rest of the string is interpreted as the name of a filehandle (or file descriptor, if numeric) to be @@ -3743,9 +3747,14 @@ array in subroutines, just like C<shift>. =item pos Returns the offset of where the last C<m//g> search left off for the variable -in question (C<$_> is used when the variable is not specified). May be -modified to change that offset. Such modification will also influence -the C<\G> zero-width assertion in regular expressions. See L<perlre> and +in question (C<$_> is used when the variable is not specified). Note that +0 is a valid match offset, while C<undef> indicates that the search position +is reset (usually due to match failure, but can also be because no match has +yet been performed on the scalar). C<pos> directly accesses the location used +by the regexp engine to store the offset, so assigning to C<pos> will change +that offset, and so will also influence the C<\G> zero-width assertion in +regular expressions. Because a failed C<m//gc> match doesn't reset the offset, +the return from C<pos> won't change either in this case. See L<perlre> and L<perlop>. =item print FILEHANDLE LIST @@ -5379,9 +5388,9 @@ meanings of the fields: (The epoch was at 00:00 January 1, 1970 GMT.) -(*) The ctime field is non-portable. In particular, you cannot expect -it to be a "creation time", see L<perlport/"Files and Filesystems"> -for details. +(*) Not all fields are supported on all filesystem types. Notably, the +ctime field is non-portable. In particular, you cannot expect it to be a +"creation time", see L<perlport/"Files and Filesystems"> for details. If C<stat> is passed the special filehandle consisting of an underline, no stat is done, but the current contents of the stat structure from the @@ -5873,11 +5882,9 @@ tell() on pipes, fifos, and sockets usually returns -1. There is no C<systell> function. Use C<sysseek(FH, 0, 1)> for that. -Do not use tell() on a filehandle that has been opened using -sysopen(), use sysseek() for that as described above. Why? Because -sysopen() creates unbuffered, "raw", filehandles, while open() creates -buffered filehandles. sysseek() make sense only on the first kind, -tell() only makes sense on the second kind. +Do not use tell() (or other buffered I/O operations) on a file handle +that has been manipulated by sysread(), syswrite() or sysseek(). +Those functions ignore the buffering, while tell() does not. =item telldir DIRHANDLE @@ -6304,7 +6311,8 @@ files. The first two elements of the list must be the NUMERICAL access and modification times, in that order. Returns the number of files successfully changed. The inode change time of each file is set to the current time. For example, this code has the same effect as the -Unix touch(1) command when the files I<already exist>. +Unix touch(1) command when the files I<already exist> and belong to +the user running the program: #!/usr/bin/perl $atime = $mtime = time; @@ -6314,7 +6322,8 @@ Since perl 5.7.2, if the first two elements of the list are C<undef>, then the utime(2) function in the C library will be called with a null second argument. On most systems, this will set the file's access and modification times to the current time (i.e. equivalent to the example -above.) +above) and will even work on other users' files where you have write +permission: utime undef, undef, @ARGV; diff --git a/gnu/usr.bin/perl/pod/perlguts.pod b/gnu/usr.bin/perl/pod/perlguts.pod index 035188e75ab..3ae04644855 100644 --- a/gnu/usr.bin/perl/pod/perlguts.pod +++ b/gnu/usr.bin/perl/pod/perlguts.pod @@ -926,8 +926,11 @@ SV. The C<name> and C<namlen> arguments are used to associate a string with the magic, typically the name of a variable. C<namlen> is stored in the -C<mg_len> field and if C<name> is non-null and C<namlen> E<gt>= 0 a malloc'd -copy of the name is stored in C<mg_ptr> field. +C<mg_len> field and if C<name> is non-null then either a C<savepvn> copy of +C<name> or C<name> itself is stored in the C<mg_ptr> field, depending on +whether C<namlen> is greater than zero or equal to zero respectively. As a +special case, if C<(name && namlen == HEf_SVKEY)> then C<name> is assumed +to contain an C<SV*> and is stored as-is with its REFCNT incremented. The sv_magic function uses C<how> to determine which, if any, predefined "Magic Virtual Table" should be assigned to the C<mg_virtual> field. @@ -944,6 +947,9 @@ count of the C<obj> object is incremented. If it is the same, or if the C<how> argument is C<PERL_MAGIC_arylen>, or if it is a NULL pointer, then C<obj> is merely stored, without the reference count being incremented. +See also C<sv_magicext> in L<perlapi> for a more flexible way to add magic +to an SV. + There is also a function to add magic to an C<HV>: void hv_magic(HV *hv, GV *gv, int how); diff --git a/gnu/usr.bin/perl/pod/perlhist.pod b/gnu/usr.bin/perl/pod/perlhist.pod index b944102193e..43da1b440a5 100644 --- a/gnu/usr.bin/perl/pod/perlhist.pod +++ b/gnu/usr.bin/perl/pod/perlhist.pod @@ -380,6 +380,8 @@ the strings?). 5.8.5-RC1 2004-Jul-06 5.8.5-RC2 2004-Jul-08 5.8.5 2004-Jul-19 + 5.8.6-RC1 2004-Nov-11 + 5.8.6 2004-Nov-27 Hugo 5.9.0 2003-Oct-27 Rafael 5.9.1 2004-Mar-16 diff --git a/gnu/usr.bin/perl/pod/perlintern.pod b/gnu/usr.bin/perl/pod/perlintern.pod index 8a2608d4330..23d0f42fc1b 100644 --- a/gnu/usr.bin/perl/pod/perlintern.pod +++ b/gnu/usr.bin/perl/pod/perlintern.pod @@ -493,6 +493,12 @@ is a CV representing a possible closure. (SvFAKE and name of '&' is not a meaningful combination currently but could become so if C<my sub foo {}> is implemented.) +The flag SVf_PADSTALE is cleared on lexicals each time the my() is executed, +and set on scope exit. This allows the 'Variable $x is not available' warning +to be generated in evals, such as + + { my $x = 1; sub f { eval '$x'} } f(); + AV * CvPADLIST(CV *cv) =for hackers diff --git a/gnu/usr.bin/perl/pod/perlipc.pod b/gnu/usr.bin/perl/pod/perlipc.pod index 5d916e832e5..76dcfed734e 100644 --- a/gnu/usr.bin/perl/pod/perlipc.pod +++ b/gnu/usr.bin/perl/pod/perlipc.pod @@ -355,11 +355,16 @@ with your timeouts. If you are having problems with such functions, you can try using the POSIX sigaction() function, which bypasses the Perl safe signals (note that this means subjecting yourself to possible memory corruption, as described above). Instead of setting -C<$SIG{ALRM}> try something like the following: +C<$SIG{ALRM}>: - use POSIX; - sigaction SIGALRM, new POSIX::SigAction sub { die "alarm\n" } - or die "Error setting SIGALRM handler: $!\n"; + local $SIG{ALRM} = sub { die "alarm" }; + +try something like the following: + + use POSIX qw(SIGALRM); + POSIX::sigaction(SIGALRM, + POSIX::SigAction->new(sub { die "alarm" })) + or die "Error setting SIGALRM handler: $!\n"; =item Restartable system calls @@ -388,7 +393,7 @@ will generate the signal again. The result of this is a rather odd "loop". In future Perl's signal mechanism may be changed to avoid this - perhaps by simply disallowing %SIG handlers on signals of that type. Until then the work-round is not to set a %SIG handler on those -signals. (Which signals they are is operating system dependant.) +signals. (Which signals they are is operating system dependent.) =item Signals triggered by operating system state diff --git a/gnu/usr.bin/perl/pod/perlop.pod b/gnu/usr.bin/perl/pod/perlop.pod index b24036a395e..3ac953426e0 100644 --- a/gnu/usr.bin/perl/pod/perlop.pod +++ b/gnu/usr.bin/perl/pod/perlop.pod @@ -190,8 +190,8 @@ Unary "-" performs arithmetic negation if the operand is numeric. If the operand is an identifier, a string consisting of a minus sign concatenated with the identifier is returned. Otherwise, if the string starts with a plus or minus, a string starting with the opposite sign -is returned. One effect of these rules is that C<-bareword> is equivalent -to C<"-bareword">. +is returned. One effect of these rules is that -bareword is equivalent +to "-bareword". Unary "~" performs bitwise negation, i.e., 1's complement. For example, C<0666 & ~027> is 0640. (See also L<Integer Arithmetic> and @@ -219,7 +219,8 @@ pattern, substitution, or transliteration. The left argument is what is supposed to be searched, substituted, or transliterated instead of the default $_. When used in scalar context, the return value generally indicates the success of the operation. Behavior in list context depends on the particular -operator. See L</"Regexp Quote-Like Operators"> for details. +operator. See L</"Regexp Quote-Like Operators"> for details and +L<perlretut> for examples using these operators. If the right argument is an expression rather than a search pattern, substitution, or transliteration, it is interpreted as a search pattern at run @@ -2034,6 +2035,14 @@ you say the compiler will precompute the number which that expression represents so that the interpreter won't have to. +=head2 No-ops + +Perl doesn't officially have a no-op operator, but the bare constants +C<0> and C<1> are special-cased to not produce a warning in a void +context, so you can for example safely do + + 1 while foo(); + =head2 Bitwise String Operators Bitstrings of any size may be manipulated by the bitwise operators diff --git a/gnu/usr.bin/perl/pod/perlre.pod b/gnu/usr.bin/perl/pod/perlre.pod index 85dc1f2d448..0db542c6b3a 100644 --- a/gnu/usr.bin/perl/pod/perlre.pod +++ b/gnu/usr.bin/perl/pod/perlre.pod @@ -201,7 +201,7 @@ as endpoints of a range, that's not a range, the "-" is understood literally. If Unicode is in effect, C<\s> matches also "\x{85}", "\x{2028}, and "\x{2029}", see L<perlunicode> for more details about C<\pP>, C<\PP>, and C<\X>, and L<perluniintro> about Unicode in general. -You can define your own C<\p> and C<\P> propreties, see L<perlunicode>. +You can define your own C<\p> and C<\P> properties, see L<perlunicode>. The POSIX character class syntax @@ -582,7 +582,7 @@ track of the number of nested parentheses. For example: Inside the C<(?{...})> block, C<$_> refers to the string the regular expression is matching against. You can also use C<pos()> to know what is -the current position of matching withing this string. +the current position of matching within this string. The C<code> is properly scoped in the following sense: If the assertion is backtracked (compare L<"Backtracking">), all changes introduced after diff --git a/gnu/usr.bin/perl/pod/perlrun.pod b/gnu/usr.bin/perl/pod/perlrun.pod index 3567ae7d693..86e84ca2058 100644 --- a/gnu/usr.bin/perl/pod/perlrun.pod +++ b/gnu/usr.bin/perl/pod/perlrun.pod @@ -6,7 +6,7 @@ perlrun - how to execute the Perl interpreter B<perl> S<[ B<-sTtuUWX> ]> S<[ B<-hv> ] [ B<-V>[:I<configvar>] ]> - S<[ B<-cw> ] [ B<-d>[:I<debugger>] ] [ B<-D>[I<number/list>] ]> + S<[ B<-cw> ] [ B<-d>[B<t>][:I<debugger>] ] [ B<-D>[I<number/list>] ]> S<[ B<-pna> ] [ B<-F>I<pattern> ] [ B<-l>[I<octal>] ] [ B<-0>[I<octal/hexadecimal>] ]> S<[ B<-I>I<dir> ] [ B<-m>[B<->]I<module> ] [ B<-M>[B<->]I<'module...'> ]> S<[ B<-P> ]> @@ -334,16 +334,24 @@ be skipped. =item B<-d> +=item B<-dt> + runs the program under the Perl debugger. See L<perldebug>. +If B<t> is specified, it indicates to the debugger that threads +will be used in the code being debugged. =item B<-d:>I<foo[=bar,baz]> +=item B<-dt:>I<foo[=bar,baz]> + runs the program under the control of a debugging, profiling, or tracing module installed as Devel::foo. E.g., B<-d:DProf> executes the program using the Devel::DProf profiler. As with the B<-M> flag, options may be passed to the Devel::foo package where they will be received and interpreted by the Devel::foo::import routine. The comma-separated list of options must follow a C<=> character. +If B<t> is specified, it indicates to the debugger that threads +will be used in the code being debugged. See L<perldebug>. =item B<-D>I<letters> @@ -360,8 +368,7 @@ As an alternative, specify a number instead of list of letters (e.g., B<-D14> is equivalent to B<-Dtls>): 1 p Tokenizing and parsing - 2 s Stack snapshots - with v, displays all stacks + 2 s Stack snapshots (with v, displays all stacks) 4 l Context (loop) stack processing 8 t Trace execution 16 o Method and overloading resolution @@ -381,7 +388,7 @@ B<-D14> is equivalent to B<-Dtls>): 262144 R Include reference counts of dumped variables (eg when using -Ds) 524288 J Do not s,t,P-debug (Jump over) opcodes within package DB 1048576 v Verbose: use in conjunction with other flags - 2097152 C Copy On Write + 8388608 q quiet - currently only suppresses the "EXECUTING" message All these flags require B<-DDEBUGGING> when you compile the Perl executable (but see L<Devel::Peek>, L<re> which may change this). @@ -523,6 +530,10 @@ folks use it for their backup files: $ perl -pi~ -e 's/foo/bar/' file1 file2 file3... +Note that because B<-i> renames or deletes the original file before +creating a new file of the same name, UNIX-style soft and hard links will +not be preserved. + Finally, the B<-i> switch does not impede execution when no files are given on the command line. In this case, no backup is made (the original file cannot, of course, be determined) and processing @@ -595,7 +606,7 @@ Note that the lines are not printed by default. See B<-p> to have lines printed. If a file named by an argument cannot be opened for some reason, Perl warns you about it and moves on to the next file. -Here is an efficient way to delete all files that haven't been modifed for +Here is an efficient way to delete all files that haven't been modified for at least a week: find . -mtime +7 -print | perl -nle unlink @@ -723,9 +734,12 @@ original name fails, and if the name does not already end in one of those suffixes. If your Perl was compiled with DEBUGGING turned on, using the -Dp switch to Perl shows how the search progresses. -Typically this is used to emulate #! startup on platforms that -don't support #!. This example works on many platforms that -have a shell compatible with Bourne shell: +Typically this is used to emulate #! startup on platforms that don't +support #!. Its also convenient when debugging a script that uses #!, +and is thus normally found by the shell's $PATH search mechanism. + +This example works on many platforms that have a shell compatible with +Bourne shell: #!/usr/bin/perl eval 'exec /usr/bin/perl -wS $0 ${1+"$@"}' @@ -817,12 +831,14 @@ prints the version and patchlevel of your perl executable. prints summary of the major perl configuration values and the current values of @INC. -=item B<-V:>I<name> +=item B<-V:>I<configvar> Prints to STDOUT the value of the named configuration variable(s), -with multiples when your query looks like a regex. -For example, +with multiples when your configvar argument looks like a regex (has +non-letters). For example: + $ perl -V:libc + libc='/lib/libc-2.2.4.so'; $ perl -V:lib. libs='-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc'; libc='/lib/libc-2.2.4.so'; @@ -843,7 +859,7 @@ you to embed queries into shell commands. (mnemonic: PATH separator compression-vars: zcat='' zip='zip' are here ! A leading colon removes the 'name=' part of the response, this allows -you to map to the name you need. +you to map to the name you need. (mnemonic: empty label) $ echo "goodvfork="`./perl -Ilib -V::usevfork` goodvfork=false; @@ -1077,6 +1093,11 @@ The command used to load the debugger code. The default is: BEGIN { require 'perl5db.pl' } +=item PERL5DB_THREADED + +If set to a true value, indicates to the debugger that the code being +debugged uses threads. + =item PERL5SHELL (specific to the Win32 port) May be set to an alternative shell that perl must use internally for @@ -1092,6 +1113,20 @@ fit for interactive use, and setting COMSPEC to such a shell may interfere with the proper functioning of other programs (which usually look in COMSPEC to find a shell fit for interactive use). +=item PERL_ALLOW_NON_IFS_LSP (specific to the Win32 port) + +Set to 1 to allow the use of non-IFS compatible LSP's. +Perl normally searches for an IFS-compatible LSP because this is required +for its emulation of Windows sockets as real filehandles. However, this may +cause problems if you have a firewall such as McAfee Guardian which requires +all applications to use its LSP which is not IFS-compatible, because clearly +Perl will normally avoid using such an LSP. +Setting this environment variable to 1 means that Perl will simply use the +first suitable LSP enumerated in the catalog, which keeps McAfee Guardian +happy (and in that particular case Perl still works too because McAfee +Guardian's LSP actually plays some other games which allow applications +requiring IFS compatibility to work). + =item PERL_DEBUG_MSTATS Relevant only if perl is compiled with the malloc included with the perl @@ -1170,7 +1205,7 @@ L<perlvms> and in F<README.vms> in the Perl source distribution. In Perls 5.8.1 and later. If set to C<unsafe> the pre-Perl-5.8.0 signals behaviour (immediate but unsafe) is restored. If set to C<safe> the safe (or deferred) signals are used. -See L<perlipc/"Deferred Signals (Safe signals)">. +See L<perlipc/"Deferred Signals (Safe Signals)">. =item PERL_UNICODE diff --git a/gnu/usr.bin/perl/pod/perlsec.pod b/gnu/usr.bin/perl/pod/perlsec.pod index 5a09e32d8ec..3174450f8e9 100644 --- a/gnu/usr.bin/perl/pod/perlsec.pod +++ b/gnu/usr.bin/perl/pod/perlsec.pod @@ -32,10 +32,10 @@ program more secure than the corresponding C program. You may not use data derived from outside your program to affect something else outside your program--at least, not by accident. All command line arguments, environment variables, locale information (see -L<perllocale>), results of certain system calls (readdir(), -readlink(), the variable of shmread(), the messages returned by -msgrcv(), the password, gcos and shell fields returned by the -getpwxxx() calls), and all file input are marked as "tainted". +L<perllocale>), results of certain system calls (C<readdir()>, +C<readlink()>, the variable of C<shmread()>, the messages returned by +C<msgrcv()>, the password, gcos and shell fields returned by the +C<getpwxxx()> calls), and all file input are marked as "tainted". Tainted data may not be used directly or indirectly in any command that invokes a sub-shell, nor in any command that modifies files, directories, or processes, B<with the following exceptions>: @@ -129,11 +129,27 @@ For example: If you try to do something insecure, you will get a fatal error saying something like "Insecure dependency" or "Insecure $ENV{PATH}". +The exception to the principle of "one tainted value taints the whole +expression" is with the ternary conditional operator C<?:>. Since code +with a ternary conditional + + $result = $tainted_value ? "Untainted" : "Also untainted"; + +is effectively + + if ( $tainted_value ) { + $result = "Untainted"; + } else { + $result = "Also untainted"; + } + +it doesn't make sense for C<$result> to be tainted. + =head2 Laundering and Detecting Tainted Data To test whether a variable contains tainted data, and whose use would thus trigger an "Insecure dependency" message, you can use the -tainted() function of the Scalar::Util module, available in your +C<tainted()> function of the Scalar::Util module, available in your nearby CPAN mirror, and included in Perl starting from the release 5.8.0. Or you may be able to use the following C<is_tainted()> function. @@ -179,7 +195,7 @@ Laundering data using regular expression is the I<only> mechanism for untainting dirty data, unless you use the strategy detailed below to fork a child of lesser privilege. -The example does not untaint $data if C<use locale> is in effect, +The example does not untaint C<$data> if C<use locale> is in effect, because the characters matched by C<\w> are determined by the locale. Perl considers that locale definitions are untrustworthy because they contain data from outside the program. If you are writing a @@ -220,16 +236,16 @@ will not. =head2 Cleaning Up Your Path -For "Insecure C<$ENV{PATH}>" messages, you need to set C<$ENV{'PATH'}> to a -known value, and each directory in the path must be non-writable by others -than its owner and group. You may be surprised to get this message even -if the pathname to your executable is fully qualified. This is I<not> -generated because you didn't supply a full path to the program; instead, -it's generated because you never set your PATH environment variable, or -you didn't set it to something that was safe. Because Perl can't -guarantee that the executable in question isn't itself going to turn -around and execute some other program that is dependent on your PATH, it -makes sure you set the PATH. +For "Insecure C<$ENV{PATH}>" messages, you need to set C<$ENV{'PATH'}> to +a known value, and each directory in the path must be absolute and +non-writable by others than its owner and group. You may be surprised to +get this message even if the pathname to your executable is fully +qualified. This is I<not> generated because you didn't supply a full path +to the program; instead, it's generated because you never set your PATH +environment variable, or you didn't set it to something that was safe. +Because Perl can't guarantee that the executable in question isn't itself +going to turn around and execute some other program that is dependent on +your PATH, it makes sure you set the PATH. The PATH isn't the only environment variable which can cause problems. Because some shells may use the variables IFS, CDPATH, ENV, and @@ -247,26 +263,26 @@ privileges. Perl doesn't prevent you from opening tainted filenames for reading, so be careful what you print out. The tainting mechanism is intended to prevent stupid mistakes, not to remove the need for thought. -Perl does not call the shell to expand wild cards when you pass B<system> -and B<exec> explicit parameter lists instead of strings with possible shell -wildcards in them. Unfortunately, the B<open>, B<glob>, and +Perl does not call the shell to expand wild cards when you pass C<system> +and C<exec> explicit parameter lists instead of strings with possible shell +wildcards in them. Unfortunately, the C<open>, C<glob>, and backtick functions provide no such alternate calling convention, so more subterfuge will be required. Perl provides a reasonably safe way to open a file or pipe from a setuid or setgid program: just create a child process with reduced privilege who does the dirty work for you. First, fork a child using the special -B<open> syntax that connects the parent and child by a pipe. Now the +C<open> syntax that connects the parent and child by a pipe. Now the child resets its ID set and any other per-process attributes, like environment variables, umasks, current working directories, back to the originals or known safe values. Then the child process, which no longer -has any special permissions, does the B<open> or other system call. +has any special permissions, does the C<open> or other system call. Finally, the child passes the data it managed to access back to the parent. Because the file or pipe was opened in the child while running under less privilege than the parent, it's not apt to be tricked into doing something it shouldn't. -Here's a way to do backticks reasonably safely. Notice how the B<exec> is +Here's a way to do backticks reasonably safely. Notice how the C<exec> is not called with a string that the shell could expand. This is by far the best way to call something that might be subjected to shell escapes: just never call the shell at all. @@ -330,7 +346,7 @@ outlaw scripts with any set-id bit set, which doesn't help much. Alternately, it can simply ignore the set-id bits on scripts. If the latter is true, Perl can emulate the setuid and setgid mechanism when it notices the otherwise useless setuid/gid bits on Perl scripts. It does -this via a special executable called B<suidperl> that is automatically +this via a special executable called F<suidperl> that is automatically invoked for you if it's needed. However, if the kernel set-id script feature isn't disabled, Perl will @@ -357,12 +373,12 @@ of the set-id script to open to the interpreter, rather than using a pathname subject to meddling, it instead passes I</dev/fd/3>. This is a special file already opened on the script, so that there can be no race condition for evil scripts to exploit. On these systems, Perl should be -compiled with C<-DSETUID_SCRIPTS_ARE_SECURE_NOW>. The B<Configure> +compiled with C<-DSETUID_SCRIPTS_ARE_SECURE_NOW>. The F<Configure> program that builds Perl tries to figure this out for itself, so you should never have to specify this yourself. Most modern releases of SysVr4 and BSD 4.4 use this approach to avoid the kernel race condition. -Prior to release 5.6.1 of Perl, bugs in the code of B<suidperl> could +Prior to release 5.6.1 of Perl, bugs in the code of F<suidperl> could introduce a security hole. =head2 Protecting Your Programs diff --git a/gnu/usr.bin/perl/pod/perlsub.pod b/gnu/usr.bin/perl/pod/perlsub.pod index 31e4f59a3cf..1a9b14597b4 100644 --- a/gnu/usr.bin/perl/pod/perlsub.pod +++ b/gnu/usr.bin/perl/pod/perlsub.pod @@ -212,7 +212,7 @@ C<DESTROY> plus all functions mentioned in L<perltie> and L<PerlIO::via>. The C<BEGIN>, C<CHECK>, C<INIT> and C<END> subroutines are not so much subroutines as named special code blocks, of which you can have more -than one in a package, and which you can B<not> call explicitely. See +than one in a package, and which you can B<not> call explicitly. See L<perlmod/"BEGIN, CHECK, INIT and END"> =head2 Private Variables via my() diff --git a/gnu/usr.bin/perl/pod/perlthrtut.pod b/gnu/usr.bin/perl/pod/perlthrtut.pod index 517fdd1b86d..8e4e4f6063b 100644 --- a/gnu/usr.bin/perl/pod/perlthrtut.pod +++ b/gnu/usr.bin/perl/pod/perlthrtut.pod @@ -602,7 +602,7 @@ communications between threads. =head2 Semaphores: Synchronizing Data Access Semaphores are a kind of generic locking mechanism. In their most basic -form, they behave very much like lockable scalars, except that thay +form, they behave very much like lockable scalars, except that they can't hold data, and that they must be explicitly unlocked. In their advanced form, they act like a kind of counter, and can allow multiple threads to have the 'lock' at any one time. diff --git a/gnu/usr.bin/perl/pod/perltie.pod b/gnu/usr.bin/perl/pod/perltie.pod index 429a6627701..b64357665f4 100644 --- a/gnu/usr.bin/perl/pod/perltie.pod +++ b/gnu/usr.bin/perl/pod/perltie.pod @@ -1118,9 +1118,11 @@ You cannot easily tie a multilevel data structure (such as a hash of hashes) to a dbm file. The first problem is that all but GDBM and Berkeley DB have size limitations, but beyond that, you also have problems with how references are to be represented on disk. One experimental -module that does attempt to address this need partially is the MLDBM -module. Check your nearest CPAN site as described in L<perlmodlib> for -source code to MLDBM. +module that does attempt to address this need is DBM::Deep. Check your +nearest CPAN site as described in L<perlmodlib> for source code. Note +that despite its name, DBM::Deep does not use dbm. Another earlier attempt +at solving the problem is MLDBM, which is also available on the CPAN, but +which has some fairly serious limitations. Tied filehandles are still incomplete. sysopen(), truncate(), flock(), fcntl(), stat() and -X can't currently be trapped. diff --git a/gnu/usr.bin/perl/pod/perltoc.pod b/gnu/usr.bin/perl/pod/perltoc.pod index 5f601c2e3a9..e89db8e34ea 100644 --- a/gnu/usr.bin/perl/pod/perltoc.pod +++ b/gnu/usr.bin/perl/pod/perltoc.pod @@ -829,7 +829,7 @@ Interaction, perlfaq9 - Networking =back -=head2 perlfaq1 - General Questions About Perl ($Revision: 1.9 $, $Date: +=head2 perlfaq1 - General Questions About Perl ($Revision: 1.10 $, $Date: 2003/07/09 15:47:28 $) =over 4 @@ -878,8 +878,8 @@ Scheme, or Tcl? =back -=head2 perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.9 $, -$Date: 2004/08/09 18:10:16 $) +=head2 perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.10 $, +$Date: 2005/01/15 21:30:38 $) =over 4 @@ -934,7 +934,7 @@ References, Tutorials, Task-Oriented, Special Topics =back -=head2 perlfaq3 - Programming Tools ($Revision: 1.9 $, $Date: 2003/08/24 +=head2 perlfaq3 - Programming Tools ($Revision: 1.10 $, $Date: 2003/08/24 05:26:59 $) =over 4 @@ -1021,7 +1021,7 @@ my C program; what am I doing wrong? =back -=head2 perlfaq4 - Data Manipulation ($Revision: 1.9 $, $Date: 2003/10/02 +=head2 perlfaq4 - Data Manipulation ($Revision: 1.10 $, $Date: 2003/10/02 04:44:33 $) =over 4 @@ -1240,7 +1240,7 @@ array of hashes or arrays? =back -=head2 perlfaq5 - Files and Formats ($Revision: 1.9 $, $Date: 2003/01/26 +=head2 perlfaq5 - Files and Formats ($Revision: 1.10 $, $Date: 2003/01/26 17:45:46 $) =over 4 @@ -1336,7 +1336,7 @@ protected files? Isn't this a bug in Perl? =back -=head2 perlfaq6 - Regular Expressions ($Revision: 1.9 $, $Date: 2003/01/03 +=head2 perlfaq6 - Regular Expressions ($Revision: 1.10 $, $Date: 2003/01/03 20:05:28 $) =over 4 @@ -1403,7 +1403,7 @@ file? =back -=head2 perlfaq7 - General Perl Language Issues ($Revision: 1.9 $, $Date: +=head2 perlfaq7 - General Perl Language Issues ($Revision: 1.10 $, $Date: 2003/07/24 02:17:21 $) =over 4 @@ -1485,7 +1485,7 @@ methods? =back -=head2 perlfaq8 - System Interaction ($Revision: 1.9 $, $Date: 2003/01/26 +=head2 perlfaq8 - System Interaction ($Revision: 1.10 $, $Date: 2003/01/26 17:44:04 $) =over 4 @@ -1613,7 +1613,7 @@ search path? =back -=head2 perlfaq9 - Networking ($Revision: 1.9 $, $Date: 2003/01/31 17:36:57 +=head2 perlfaq9 - Networking ($Revision: 1.10 $, $Date: 2003/01/31 17:36:57 $) =over 4 @@ -1834,6 +1834,8 @@ regular expressions =item Constant Folding +=item No-ops + =item Bitwise String Operators =item Integer Arithmetic @@ -2252,7 +2254,7 @@ I<commandline>, B<-F>I<pattern>, B<-h>, B<-i>[I<extension>], B<-I>I<directory>, B<-l>[I<octnum>], B<-m>[B<->]I<module>, B<-M>[B<->]I<module>, B<-M>[B<->]I<'module ...'>, B<-[mM]>[B<->]I<module=arg[,arg]...>, B<-n>, B<-p>, B<-P>, B<-s>, B<-S>, -B<-t>, B<-T>, B<-u>, B<-U>, B<-v>, B<-V>, B<-V:>I<name>, B<-w>, B<-W>, +B<-t>, B<-T>, B<-u>, B<-U>, B<-v>, B<-V>, B<-V:>I<configvar>, B<-w>, B<-W>, B<-X>, B<-x>, B<-x> I<directory> =back @@ -2261,10 +2263,11 @@ B<-X>, B<-x>, B<-x> I<directory> HOME, LOGDIR, PATH, PERL5LIB, PERL5OPT, PERLIO, :bytes, :crlf, :mmap, :perlio, :pop, :raw, :stdio, :unix, :utf8, :win32, PERLIO_DEBUG, PERLLIB, -PERL5DB, PERL5SHELL (specific to the Win32 port), PERL_DEBUG_MSTATS, -PERL_DESTRUCT_LEVEL, PERL_DL_NONLAZY, PERL_ENCODING, PERL_HASH_SEED, -PERL_HASH_SEED_DEBUG, PERL_ROOT (specific to the VMS port), PERL_SIGNALS, -PERL_UNICODE, SYS$LOGIN (specific to the VMS port) +PERL5DB, PERL5SHELL (specific to the Win32 port), PERL_ALLOW_NON_IFS_LSP +(specific to the Win32 port), PERL_DEBUG_MSTATS, PERL_DESTRUCT_LEVEL, +PERL_DL_NONLAZY, PERL_ENCODING, PERL_HASH_SEED, PERL_HASH_SEED_DEBUG, +PERL_ROOT (specific to the VMS port), PERL_SIGNALS, PERL_UNICODE, SYS$LOGIN +(specific to the VMS port) =back @@ -3889,9 +3892,9 @@ Look around, Check it's new, Discuss the need, Choose a name, Check again =item Step-by-step: Making the module -Start with F<h2xs>, Use L<strict|strict> and L<warnings|warnings>, Use -L<Carp|Carp>, Use L<Exporter|Exporter> - wisely!, Use L<plain old -documentation|perlpod>, Write tests, Write the README +Start with F<module-starter> or F<h2xs>, Use L<strict|strict> and +L<warnings|warnings>, Use L<Carp|Carp>, Use L<Exporter|Exporter> - wisely!, +Use L<plain old documentation|perlpod>, Write tests, Write the README =item Step-by-step: Distributing your module @@ -4688,8 +4691,8 @@ SvSetSV, SvSetSV_nosteal, SvSHARE, SvUNLOCK =item Memory Management -Copy, Move, New, Newc, Newz, Poison, Renew, Renewc, Safefree, savepv, -savepvn, savesharedpv, StructCopy, Zero +Copy, CopyD, Move, MoveD, New, Newc, Newz, Poison, Renew, Renewc, Safefree, +savepv, savepvn, savesharedpv, StructCopy, Zero, ZeroD =item Miscellaneous Functions @@ -4734,30 +4737,31 @@ SvNIOK_off, SvNOK, SvNOKp, SvNOK_off, SvNOK_on, SvNOK_only, SvNV, SvNVx, SvNVX, SvOK, SvOOK, SvPOK, SvPOKp, SvPOK_off, SvPOK_on, SvPOK_only, SvPOK_only_UTF8, SvPV, SvPVbyte, SvPVbytex, SvPVbytex_force, SvPVbyte_force, SvPVbyte_nolen, SvPVutf8, SvPVutf8x, SvPVutf8x_force, -SvPVutf8_force, SvPVutf8_nolen, SvPVX, SvPVx, SvPV_force, SvPV_force_nomg, +SvPVutf8_force, SvPVutf8_nolen, SvPVx, SvPVX, SvPV_force, SvPV_force_nomg, SvPV_nolen, SvREFCNT, SvREFCNT_dec, SvREFCNT_inc, SvROK, SvROK_off, SvROK_on, SvRV, SvSTASH, SvTAINT, SvTAINTED, SvTAINTED_off, SvTAINTED_on, SvTRUE, SvTYPE, SvUOK, SvUPGRADE, SvUTF8, SvUTF8_off, SvUTF8_on, SvUV, SvUVx, SvUVX, sv_2bool, sv_2cv, sv_2io, sv_2iv, sv_2mortal, sv_2nv, sv_2pvbyte, sv_2pvbyte_nolen, sv_2pvutf8, sv_2pvutf8_nolen, sv_2pv_flags, sv_2pv_nolen, sv_2uv, sv_backoff, sv_bless, sv_catpv, sv_catpvf, -sv_catpvf_mg, sv_catpvn, sv_catpvn_flags, sv_catpvn_mg, sv_catpv_mg, -sv_catsv, sv_catsv_flags, sv_catsv_mg, sv_chop, sv_clear, sv_cmp, -sv_cmp_locale, sv_collxfrm, sv_copypv, sv_dec, sv_derived_from, sv_eq, -sv_force_normal, sv_force_normal_flags, sv_free, sv_gets, sv_grow, sv_inc, -sv_insert, sv_isa, sv_isobject, sv_iv, sv_len, sv_len_utf8, sv_magic, -sv_magicext, sv_mortalcopy, sv_newmortal, sv_newref, sv_nv, sv_pos_b2u, -sv_pos_u2b, sv_pv, sv_pvbyte, sv_pvbyten, sv_pvbyten_force, sv_pvn, -sv_pvn_force, sv_pvn_force_flags, sv_pvutf8, sv_pvutf8n, sv_pvutf8n_force, -sv_reftype, sv_replace, sv_report_used, sv_reset, sv_rvweaken, sv_setiv, -sv_setiv_mg, sv_setnv, sv_setnv_mg, sv_setpv, sv_setpvf, sv_setpvf_mg, -sv_setpviv, sv_setpviv_mg, sv_setpvn, sv_setpvn_mg, sv_setpv_mg, -sv_setref_iv, sv_setref_nv, sv_setref_pv, sv_setref_pvn, sv_setref_uv, -sv_setsv, sv_setsv_flags, sv_setsv_mg, sv_setuv, sv_setuv_mg, sv_taint, -sv_tainted, sv_true, sv_unmagic, sv_unref, sv_unref_flags, sv_untaint, -sv_upgrade, sv_usepvn, sv_usepvn_mg, sv_utf8_decode, sv_utf8_downgrade, -sv_utf8_encode, sv_utf8_upgrade, sv_utf8_upgrade_flags, sv_uv, sv_vcatpvfn, -sv_vsetpvfn +sv_catpvf_mg, sv_catpvn, sv_catpvn_flags, sv_catpvn_mg, sv_catpvn_nomg, +sv_catpv_mg, sv_catsv, sv_catsv_flags, sv_catsv_mg, sv_catsv_nomg, sv_chop, +sv_clear, sv_cmp, sv_cmp_locale, sv_collxfrm, sv_copypv, sv_dec, +sv_derived_from, sv_eq, sv_force_normal, sv_force_normal_flags, sv_free, +sv_gets, sv_grow, sv_inc, sv_insert, sv_isa, sv_isobject, sv_iv, sv_len, +sv_len_utf8, sv_magic, sv_magicext, sv_mortalcopy, sv_newmortal, sv_newref, +sv_nv, sv_pos_b2u, sv_pos_u2b, sv_pv, sv_pvbyte, sv_pvbyten, +sv_pvbyten_force, sv_pvn, sv_pvn_force, sv_pvn_force_flags, sv_pvutf8, +sv_pvutf8n, sv_pvutf8n_force, sv_reftype, sv_replace, sv_report_used, +sv_reset, sv_rvweaken, sv_setiv, sv_setiv_mg, sv_setnv, sv_setnv_mg, +sv_setpv, sv_setpvf, sv_setpvf_mg, sv_setpviv, sv_setpviv_mg, sv_setpvn, +sv_setpvn_mg, sv_setpv_mg, sv_setref_iv, sv_setref_nv, sv_setref_pv, +sv_setref_pvn, sv_setref_uv, sv_setsv, sv_setsv_flags, sv_setsv_mg, +sv_setsv_nomg, sv_setuv, sv_setuv_mg, sv_taint, sv_tainted, sv_true, +sv_unmagic, sv_unref, sv_unref_flags, sv_untaint, sv_upgrade, sv_usepvn, +sv_usepvn_mg, sv_utf8_decode, sv_utf8_downgrade, sv_utf8_encode, +sv_utf8_upgrade, sv_utf8_upgrade_flags, sv_uv, sv_vcatpvf, sv_vcatpvfn, +sv_vcatpvf_mg, sv_vsetpvf, sv_vsetpvfn, sv_vsetpvf_mg =item Unicode Support @@ -5029,7 +5033,7 @@ t/cmd t/run t/io t/op, t/lib ext lib coretest, test.deparse, test.taintwarn, minitest, test.valgrind check.valgrind utest.valgrind ucheck.valgrind, test.third check.third utest.third ucheck.third, test.torture torturetest, utest ucheck test.utf8 -check.utf8, test_harness +check.utf8, minitest.utf16 test.utf16, test_harness =item Running tests by hand @@ -5096,356 +5100,155 @@ I<The Road goes ever on and on, down from the door where it began.> =item DESCRIPTION -=item To do during 5.6.x - -=over 4 - -=item Support for I/O disciplines - -=item Autoload bytes.pm - -=item Make "\u{XXXX}" et al work - -=item Create a char *sv_pvprintify(sv, STRLEN *lenp, UV flags) - -=item Overloadable regex assertions - -=item Unicode - -=item Work out exit/die semantics for threads - -=item Better support for nonpreemptive threading systems like GNU pth - -=item Typed lexicals for compiler - -=item Compiler workarounds for Win32 - -=item AUTOLOADing in the compiler - -=item Fixing comppadlist when compiling - -=item Cleaning up exported namespace - -=item Complete signal handling - -=item Out-of-source builds - -=item POSIX realtime support - -=item UNIX98 support - -=item IPv6 Support - -=item Long double conversion - -=item Locales - -=item Arithmetic on non-Arabic numerals - -=item POSIX Unicode character classes - -=item Factoring out common suffices/prefices in regexps (trie optimization) - -=item Security audit shipped utilities - -=item Sort out the uid-setting mess - -=item Custom opcodes - -=item DLL Versioning - -=item Introduce @( and @) - -=item Floating point handling - -=item IV/UV preservation +=item assertions -=item Replace pod2html with something using Pod::Parser +=item iCOW -=item Automate module testing on CPAN +=item (?{...}) closures in regexps -=item sendmsg and recvmsg +=item A re-entrant regexp engine -=item Rewrite perlre documentation +=item pragmata -=item Convert example code to IO::Handle filehandles - -=item Document Win32 choices +=over 4 -=item Check new modules +=item lexical pragmas -=item Make roffitall find pods and libs itself +=item use less 'memory' =back -=item To do at some point +=item prototypes and functions =over 4 -=item Remove regular expression recursion - -=item Memory leaks after failed eval - -=item bitfields in pack - -=item Cross compilation - -=item Perl preprocessor / macros - -=item Perl lexer in Perl - -=item Using POSIX calls internally - -=item -i rename file when changed - -=item All ARGV input should act like E<lt>E<gt> - -=item Support for rerunning debugger - -=item Test Suite for the Debugger - -=item my sub foo { } - -=item One-pass global destruction - -=item Rewrite regexp parser - -=item Cache recently used regexps - -=item Cross-compilation support - -=item Bit-shifting bitvectors - -=item debugger pragma - -=item use less pragma - -=item switch structures - -=item Cache eval tree - -=item rcatmaybe - -=item Shrink opcode tables - -=item Optimize away @_ - -=item Prototypes versus indirect objects - -=item Install HTML - -=item Prototype method calls - -=item Return context prototype declarations - -=item magic_setisa - -=item Garbage collection - -=item IO tutorial - -=item Rewrite perldoc +=item _ prototype character -=item Install .3p manpages - -=item Unicode tutorial - -=item Update POSIX.pm for 1003.1-2 - -=item Retargetable installation - -=item POSIX emulation on non-POSIX systems - -=item Rename Win32 headers +=item inlining autoloaded constants =item Finish off lvalue functions -=item Update sprintf documentation - -=item Use fchown/fchmod internally - -=item Make v-strings overloaded objects - -=item Allow restricted hash assignment - -=item Should overload be inheritable? - -=item Taint rethink - -=item Perform correctly when XSUBs call subroutines that exit via -goto(LABEL) and friends - =back -=item Vague ideas +=item Unicode and UTF8 =over 4 -=item ref() in list context - -=item Make tr/// return histogram of characters in list context - -=item Compile to real threaded code - -=item Structured types - -=item Modifiable $1 et al. - -=item Procedural interfaces for IO::*, etc. +=item Implicit Latin 1 => Unicode translation -=item RPC modules +=item UTF8 caching code -=item Attach/detach debugger from running program - -=item GUI::Native - -=item foreach(reverse ...) - -=item Constant function cache +=item Unicode in Filenames -=item Approximate regular expression matching +=item Unicode in %ENV =back -=item Ongoing +=item Regexps =over 4 -=item Update guts documentation - -=item Add more tests - -=item Update auxiliary tools - -=item Create debugging macros +=item regexp optimiser optional -=item truncate to the people - -=item Unicode in Filenames +=item common suffices/prefices in regexps (trie optimization) =back -=item Unicode in %ENV - -=item Recently done things +=item POD =over 4 -=item Alternative RE syntax module - -=item Safe signal handling - -=item Tie Modules - -=item gettimeofday +=item POD -> HTML conversion still sucks -=item setitimer and getimiter - -=item Testing __DIE__ hook - -=item CPP equivalent in Perl - -=item Explicit switch statements - -=item autocroak - -=item UTF/EBCDIC - -=item UTF Regexes - -=item perlcc to produce executable - -=item END blocks saved in compiled output +=back -=item Secure temporary file module +=item Misc medium sized projects -=item Integrate Time::HiRes +=over 4 -=item Turn Cwd into XS +=item UNITCHECK -=item Mmap for input +=item optional optimizer -=item Byte to/from UTF-8 and UTF-8 to/from local conversion +=item You WANT *how* many -=item Add sockatmark support +=item lexical aliases -=item Mailing list archives +=item no 6 -=item Bug tracking +=item IPv6 -=item Integrate MacPerl +=item entersub XS vs Perl -=item Web "nerve center" for Perl +=item @INC source filter to Filter::Simple -=item Regular expression tutorial +=item bincompat functions -=item Debugging Tutorial +=item Use fchown/fchmod internally -=item Integrate new modules +=back -=item Integrate profiler +=item Tests -=item Y2K error detection +=over 4 -=item Regular expression debugger +=item Make Schwern poorer -=item POD checker +=item test B -=item "Dynamic" lexicals +=item Improve tests for Config.pm -=item Cache precompiled modules +=item common test code for timed bailout =back -=item Deprecated Wishes +=item Installation =over 4 -=item Loop control on do{} - -=item Lexically scoped typeglobs +=item compressed man pages -=item format BOTTOM +=item Make Config.pm cope with differences between build and installed perl -=item report HANDLE +=item Relocatable perl -=item Generalised want()/caller()) +=item make HTML install work -=item Named prototypes +=item put patchlevel in -v -=item Built-in globbing +=back -=item Regression tests for suidperl +=item Incremental things -=item Cached hash values +=over 4 -=item Add compression modules +=item autovivification -=item Reorganise documentation into tutorials/references +=item fix tainting bugs -=item Remove distinction between functions and operators +=item Make tainting consistent -=item Make XS easier to use +=item Dual life everything -=item Make embedding easier to use +=back -=item man for perl +=item Vague things -=item my $Package::variable +=over 4 -=item "or" tests defined, not truth +=item threads -=item "class"-based lexicals +=item POSIX memory footprint -=item byteperl +=item Optimize away @_ -=item Lazy evaluation / tail recursion removal +=item switch ops -=item Make "use utf8" the default +=item Attach/detach debugger from running program -=item Unicode collation and normalization +=item A decent benchmark -=item pack/unpack tutorial +=item readpipe(LIST) =back @@ -5506,7 +5309,7 @@ B<-V> =back -=head2 perldelta, perl584delta - what is new for perl v5.8.4 +=head2 perldelta - what is new for perl v5.8.5 =over 4 @@ -5516,36 +5319,52 @@ B<-V> =item Core Enhancements -=over 4 +=item Modules and Pragmata -=item Malloc wrapping +=item Utility Changes -=item Unicode Character Database 4.0.1 +=item New Documentation -=item suidperl less insecure +=item Performance Enhancements -=item format +=item Installation and Configuration Improvements + +=item Selected Bug Fixes + +=item New or Changed Diagnostics + +=item Changed Internals + +=item New Tests + +=item Known Problems + +=item Platform Specific Problems + +=item Reporting Bugs + +=item SEE ALSO =back -=item Modules and Pragmata +=head2 perl586delta, perldelta - what is new for perl v5.8.5 =over 4 -=item Updated modules +=item DESCRIPTION -Attribute::Handlers, B, Benchmark, CGI, Carp, Cwd, Exporter, File::Find, -IO, IPC::Open3, Local::Maketext, Math::BigFloat, Math::BigInt, -Math::BigRat, MIME::Base64, ODBM_File, POSIX, Shell, Socket, Storable, -Switch, Sys::Syslog, Term::ANSIColor, Time::HiRes, Unicode::UCD, Win32, -base, open, threads, utf8 +=item Incompatible Changes -=back +=item Core Enhancements -=item Performance Enhancements +=item Modules and Pragmata =item Utility Changes +=item New Documentation + +=item Performance Enhancements + =item Installation and Configuration Improvements =item Selected Bug Fixes @@ -5554,7 +5373,9 @@ base, open, threads, utf8 =item Changed Internals -=item Future Directions +=item New Tests + +=item Known Problems =item Platform Specific Problems @@ -5564,7 +5385,7 @@ base, open, threads, utf8 =back -=head2 perl585delta, perldelta - what is new for perl v5.8.5 +=head2 perl585delta - what is new for perl v5.8.5 =over 4 @@ -5586,10 +5407,6 @@ base, open, threads, utf8 =back -=item New Documentation - -=item Performance Enhancements - =item Installation and Configuration Improvements =item Selected Bug Fixes @@ -5598,8 +5415,6 @@ base, open, threads, utf8 =item Changed Internals -=item New Tests - =item Known Problems =item Platform Specific Problems @@ -8138,18 +7953,18 @@ DJGPP, Pthreads =item PA-RISC +=item Portability Between PA-RISC Versions + =item PA-RISC 1.0 =item PA-RISC 1.1 =item PA-RISC 2.0 -=item Itanium & Itanium 2 - -=item Portability Between PA-RISC Versions - =item Itanium Processor Family and HP-UX +=item Itanium & Itanium 2 + =item Building Dynamic Extensions on HP-UX =item The HP ANSI C Compiler @@ -9106,8 +8921,9 @@ LIST, waitpid PID,FLAGS =item Setting Up Perl on Win32 -Make, Command Shell, Borland C++, Microsoft Visual C++, Microsoft Platform -SDK 64-bit Compiler, MinGW release 3 with gcc, MinGW release 1 with gcc +Make, Command Shell, Borland C++, Microsoft Visual C++, Microsoft Visual +C++ Toolkit 2003, Microsoft Platform SDK 64-bit Compiler, MinGW release 3 +with gcc, MinGW release 1 with gcc =item Building @@ -9123,7 +8939,7 @@ Extensions, Notes on 64-bit Windows =item Running Perl Scripts -Miscellaneous Things +=item Miscellaneous Things =back @@ -9595,6 +9411,12 @@ Legend of characters above literals in regex that are longer than 127 bytes, EBCDIC, format +=over 4 + +=item The Logic of :locale + +=back + =item HISTORY =item SEE ALSO @@ -10218,7 +10040,8 @@ FILL, MAX, KEYS, RITER, NAME, PMROOT, ARRAY =item B::OP Methods -next, sibling, name, ppaddr, desc, targ, type, seq, flags, private +next, sibling, name, ppaddr, desc, targ, type, opt, static, flags, private, +spare =item B::UNOP METHOD @@ -10427,30 +10250,40 @@ B<-base>I<n>, B<-bigendian>, B<-littleendian> =item Other options -B<-main>, B<-banner> +B<-main>, B<-nomain>, B<-nobanner>, B<-banner>, B<-banneris> => subref =item Option Stickiness =back +=item ABBREVIATIONS + +=over 4 + +=item OP class abbreviations + +=item OP flags abbreviations + +=back + =item FORMATTING SPECIFICATIONS +=over 4 + +=item Special Patterns + B<(x(>I<exec_text>B<;>I<basic_text>B<)x)>, B<(*(>I<text>B<)*)>, B<(*(>I<text1>B<;>I<text2>B<)*)>, B<(?(>I<text1>B<#>I<var>I<Text2>B<)?)>, -B<#>I<var>, B<#>I<var>I<N>, B<~>, B<#addr>, B<#arg>, B<#class>, +B<~> + +=item # Variables + +B<#>I<var>, B<#>I<var>I<N>, B<#>I<Var>, B<#addr>, B<#arg>, B<#class>, B<#classsym>, B<#coplabel>, B<#exname>, B<#extarg>, B<#firstaddr>, B<#flags>, B<#flagval>, B<#hyphseq>, B<#label>, B<#lastaddr>, B<#name>, B<#NAME>, B<#next>, B<#nextaddr>, B<#noise>, B<#private>, B<#privval>, -B<#seq>, B<#seqnum>, B<#sibaddr>, B<#svaddr>, B<#svclass>, B<#svval>, -B<#targ>, B<#targarg>, B<#targarglife>, B<#typenum> - -=item ABBREVIATIONS - -=over 4 - -=item OP flags abbreviations - -=item OP class abbreviations +B<#seq>, B<#seqnum>, B<#opt>, B<#static>, B<#sibaddr>, B<#svaddr>, +B<#svclass>, B<#svval>, B<#targ>, B<#targarg>, B<#targarglife>, B<#typenum> =back @@ -10591,6 +10424,18 @@ B<-u Package> =item DESCRIPTION +=item EXAMPLES + +=over 4 + +=item OPTIONS + +=back + +=item SEE ALSO + +=item TODO + =item AUTHOR =back @@ -11338,6 +11183,30 @@ module =back +=back + +=over 4 + +=item GLOBAL VARIABLES + +=over 4 + +=item $Carp::CarpLevel + +=item $Carp::MaxEvalLen + +=item $Carp::MaxArgLen + +=item $Carp::MaxArgNums + +=item $Carp::Verbose + +=back + +=back + +=over 4 + =item BUGS =back @@ -12078,13 +11947,45 @@ Dumper =over 4 +=item Why use ppport.h? + +You should use F<ppport.h> in modern code so that your code will work +with the widest range of Perl interpreters possible, without significant +additional work. + +=item How to use ppport.h + +=item Running ppport.h + +=back + +=item FUNCTIONS + +=over 4 + =item WriteFile =back -=item ppport.h +=item COMPATIBILITY -=item AUTHOR +=over 4 + +=item Provided Perl compatibility API + +=item Perl API not supported by ppport.h + +perl 5.9.2, perl 5.9.1, perl 5.9.0, perl 5.8.3, perl 5.8.1, perl 5.8.0, +perl 5.7.3, perl 5.7.2, perl 5.7.1, perl 5.6.1, perl 5.6.0, perl 5.005_03, +perl 5.005, perl 5.004_05, perl 5.004_04, perl 5.004 + +=back + +=item BUGS + +=item AUTHORS + +=item COPYRIGHT =item SEE ALSO @@ -13057,6 +12958,12 @@ Legend of characters above literals in regex that are longer than 127 bytes, EBCDIC, format +=over 4 + +=item The Logic of :locale + +=back + =item HISTORY =item SEE ALSO @@ -14657,7 +14564,7 @@ splitdir, catpath(), abs2rel, rel2abs() =item SEE ALSO -=item AUTHORS +=item AUTHOR =back @@ -16587,7 +16494,8 @@ of quoted-printable strings =item DESCRIPTION -encode_qp($str), encode_qp($str, $eol), decode_qp($str); +encode_qp($str), encode_qp($str, $eol), encode_qp($str, $eol, $binmode), +decode_qp($str); =item COPYRIGHT @@ -16604,7 +16512,8 @@ strings =item DESCRIPTION -encode_qp($str), encode_qp($str, $eol), decode_qp($str); +encode_qp($str), encode_qp($str, $eol), encode_qp($str, $eol, $binmode), +decode_qp($str); =item COPYRIGHT diff --git a/gnu/usr.bin/perl/pod/perlvar.pod b/gnu/usr.bin/perl/pod/perlvar.pod index 9078a2021ed..73a5be5c957 100644 --- a/gnu/usr.bin/perl/pod/perlvar.pod +++ b/gnu/usr.bin/perl/pod/perlvar.pod @@ -778,7 +778,9 @@ you may use the CPAN module C<Linux::Pid>. The real uid of this process. (Mnemonic: it's the uid you came I<from>, if you're running setuid.) You can change both the real uid and -the effective uid at the same time by using POSIX::setuid(). +the effective uid at the same time by using POSIX::setuid(). Since +changes to $< require a system call, check $! after a change attempt to +detect any possible errors. =item $EFFECTIVE_USER_ID @@ -792,7 +794,8 @@ The effective uid of this process. Example: ($<,$>) = ($>,$<); # swap real and effective uid You can change both the effective uid and the real uid at the same -time by using POSIX::setuid(). +time by using POSIX::setuid(). Changes to $> require a check to $! +to detect any possible errors after an attempted change. (Mnemonic: it's the uid you went I<to>, if you're running setuid.) C<< $< >> and C<< $> >> can be swapped only on machines @@ -815,7 +818,8 @@ set the real gid. So the value given by C<$(> should I<not> be assigned back to C<$(> without being forced numeric, such as by adding zero. You can change both the real gid and the effective gid at the same -time by using POSIX::setgid(). +time by using POSIX::setgid(). Changes to $( require a check to $! +to detect any possible errors after an attempted change. (Mnemonic: parentheses are used to I<group> things. The real gid is the group you I<left>, if you're running setgid.) @@ -841,6 +845,8 @@ list, say C< $) = "5 5" >. You can change both the effective gid and the real gid at the same time by using POSIX::setgid() (use only a single numeric argument). +Changes to $) require a check to $! to detect any possible errors +after an attempted change. (Mnemonic: parentheses are used to I<group> things. The effective gid is the group that's I<right> for you, if you're running setgid.) diff --git a/gnu/usr.bin/perl/pp.c b/gnu/usr.bin/perl/pp.c index 0f5a61a0d04..6a0bc899f8e 100644 --- a/gnu/usr.bin/perl/pp.c +++ b/gnu/usr.bin/perl/pp.c @@ -13,6 +13,13 @@ * and no knowing what you'll find around a corner. And Elves, sir!" --Samwise */ +/* This file contains general pp ("push/pop") functions that execute the + * opcodes that make up a perl program. A typical pp function expects to + * find its arguments on the stack, and usually pushes its results onto + * the stack, hence the 'pp' terminology. Each OP structure contains + * a pointer to the relevant pp_foo() function. + */ + #include "EXTERN.h" #define PERL_IN_PP_C #include "perl.h" @@ -152,6 +159,8 @@ PP(pp_rv2gv) /* If this is a 'my' scalar and flag is set then vivify * NI-S 1999/05/07 */ + if (SvREADONLY(sv)) + Perl_croak(aTHX_ PL_no_modify); if (PL_op->op_private & OPpDEREF) { char *name; GV *gv; @@ -169,7 +178,7 @@ PP(pp_rv2gv) if (SvTYPE(sv) < SVt_RV) sv_upgrade(sv, SVt_RV); if (SvPVX(sv)) { - (void)SvOOK_off(sv); /* backoff */ + SvOOK_off(sv); /* backoff */ if (SvLEN(sv)) Safefree(SvPVX(sv)); SvLEN(sv)=SvCUR(sv)=0; @@ -816,12 +825,12 @@ PP(pp_undef) break; default: if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) { - (void)SvOOK_off(sv); + SvOOK_off(sv); Safefree(SvPVX(sv)); SvPV_set(sv, Nullch); SvLEN_set(sv, 0); } - (void)SvOK_off(sv); + SvOK_off(sv); SvSETMAGIC(sv); } @@ -1726,11 +1735,11 @@ PP(pp_lt) #ifdef PERL_PRESERVE_IVUV else #endif - if (SvROK(TOPs) && SvROK(TOPm1s)) { - SP--; - SETs(boolSV(SvRV(TOPs) < SvRV(TOPp1s))); - RETURN; - } + if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { + SP--; + SETs(boolSV(SvRV(TOPs) < SvRV(TOPp1s))); + RETURN; + } #endif { dPOPnv; @@ -1804,7 +1813,7 @@ PP(pp_gt) #ifdef PERL_PRESERVE_IVUV else #endif - if (SvROK(TOPs) && SvROK(TOPm1s)) { + if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { SP--; SETs(boolSV(SvRV(TOPs) > SvRV(TOPp1s))); RETURN; @@ -1882,7 +1891,7 @@ PP(pp_le) #ifdef PERL_PRESERVE_IVUV else #endif - if (SvROK(TOPs) && SvROK(TOPm1s)) { + if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { SP--; SETs(boolSV(SvRV(TOPs) <= SvRV(TOPp1s))); RETURN; @@ -1960,7 +1969,7 @@ PP(pp_ge) #ifdef PERL_PRESERVE_IVUV else #endif - if (SvROK(TOPs) && SvROK(TOPm1s)) { + if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { SP--; SETs(boolSV(SvRV(TOPs) >= SvRV(TOPp1s))); RETURN; @@ -1977,7 +1986,7 @@ PP(pp_ne) { dSP; tryAMAGICbinSET(ne,0); #ifndef NV_PRESERVES_UV - if (SvROK(TOPs) && SvROK(TOPm1s)) { + if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { SP--; SETs(boolSV(SvRV(TOPs) != SvRV(TOPp1s))); RETURN; @@ -2046,7 +2055,7 @@ PP(pp_ncmp) { dSP; dTARGET; tryAMAGICbin(ncmp,0); #ifndef NV_PRESERVES_UV - if (SvROK(TOPs) && SvROK(TOPm1s)) { + if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { UV right = PTR2UV(SvRV(POPs)); UV left = PTR2UV(SvRV(TOPs)); SETi((left > right) - (left < right)); @@ -3121,7 +3130,7 @@ PP(pp_substr) sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0); } else - (void)SvOK_off(TARG); + SvOK_off(TARG); LvTYPE(TARG) = 'x'; if (LvTARG(TARG) != sv) { @@ -3736,7 +3745,7 @@ PP(pp_aslice) } if (GIMME != G_ARRAY) { MARK = ORIGMARK; - *++MARK = *SP; + *++MARK = SP > ORIGMARK ? *SP : &PL_sv_undef; SP = MARK; } RETURN; @@ -3956,7 +3965,7 @@ PP(pp_hslice) } if (GIMME != G_ARRAY) { MARK = ORIGMARK; - *++MARK = *SP; + *++MARK = SP > ORIGMARK ? *SP : &PL_sv_undef; SP = MARK; } RETURN; @@ -4132,6 +4141,13 @@ PP(pp_splice) if (newlen && !AvREAL(ary) && AvREIFY(ary)) av_reify(ary); + /* make new elements SVs now: avoid problems if they're from the array */ + for (dst = MARK, i = newlen; i; i--) { + SV *h = *dst; + *dst = NEWSV(46, 0); + sv_setsv(*dst++, h); + } + if (diff < 0) { /* shrinking the area */ if (newlen) { New(451, tmparyval, newlen, SV*); /* so remember insertion */ @@ -4188,11 +4204,7 @@ PP(pp_splice) dst[--i] = &PL_sv_undef; if (newlen) { - for (src = tmparyval, dst = AvARRAY(ary) + offset; - newlen; newlen--) { - *dst = NEWSV(46, 0); - sv_setsv(*dst++, *src++); - } + Copy( tmparyval, AvARRAY(ary) + offset, newlen, SV* ); Safefree(tmparyval); } } @@ -4231,10 +4243,10 @@ PP(pp_splice) } } - for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) { - *dst = NEWSV(46, 0); - sv_setsv(*dst++, *src++); + if (newlen) { + Copy( MARK, AvARRAY(ary) + offset, newlen, SV* ); } + MARK = ORIGMARK + 1; if (GIMME == G_ARRAY) { /* copy return vals to stack */ if (length) { @@ -4441,7 +4453,6 @@ PP(pp_split) I32 origlimit = limit; I32 realarray = 0; I32 base; - AV *oldstack = PL_curstack; I32 gimme = GIMME_V; I32 oldsave = PL_savestack_ix; I32 make_mortal = 1; @@ -4494,8 +4505,7 @@ PP(pp_split) AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */ } /* temporarily switch stacks */ - SWITCHSTACK(PL_curstack, ary); - PL_curstackinfo->si_stack = ary; + SAVESWITCHSTACK(PL_curstack, ary); make_mortal = 0; } } @@ -4664,7 +4674,6 @@ PP(pp_split) } } - LEAVE_SCOPE(oldsave); iters = (SP - PL_stack_base) - base; if (iters > maxiters) DIE(aTHX_ "Split loop"); @@ -4690,10 +4699,11 @@ PP(pp_split) } } + PUTBACK; + LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */ + SPAGAIN; if (realarray) { if (!mg) { - SWITCHSTACK(ary, oldstack); - PL_curstackinfo->si_stack = oldstack; if (SvSMAGICAL(ary)) { PUTBACK; mg_set((SV*)ary); diff --git a/gnu/usr.bin/perl/pp_ctl.c b/gnu/usr.bin/perl/pp_ctl.c index fd8423bd031..3a64acd879a 100644 --- a/gnu/usr.bin/perl/pp_ctl.c +++ b/gnu/usr.bin/perl/pp_ctl.c @@ -17,6 +17,17 @@ * And whither then? I cannot say. */ +/* This file contains control-oriented pp ("push/pop") functions that + * execute the opcodes that make up a perl program. A typical pp function + * expects to find its arguments on the stack, and usually pushes its + * results onto the stack, hence the 'pp' terminology. Each OP structure + * contains a pointer to the relevant pp_foo() function. + * + * Control-oriented means things like pp_enteriter() and pp_next(), which + * alter the flow of control of the program. + */ + + #include "EXTERN.h" #define PERL_IN_PP_CTL_C #include "perl.h" @@ -187,13 +198,16 @@ PP(pp_substcont) { SV *targ = cx->sb_targ; - if (DO_UTF8(dstr) && !SvUTF8(targ)) - sv_catpvn_utf8_upgrade(dstr, s, cx->sb_strend - s, nsv); - else - sv_catpvn(dstr, s, cx->sb_strend - s); + assert(cx->sb_strend >= s); + if(cx->sb_strend > s) { + if (DO_UTF8(dstr) && !SvUTF8(targ)) + sv_catpvn_utf8_upgrade(dstr, s, cx->sb_strend - s, nsv); + else + sv_catpvn(dstr, s, cx->sb_strend - s); + } cx->sb_rxtainted |= RX_MATCH_TAINTED(rx); - (void)SvOOK_off(targ); + SvOOK_off(targ); if (SvLEN(targ)) Safefree(SvPVX(targ)); SvPVX(targ) = SvPVX(dstr); @@ -338,7 +352,8 @@ PP(pp_formline) NV value; bool gotsome = FALSE; STRLEN len; - STRLEN fudge = SvCUR(tmpForm) * (IN_BYTES ? 1 : 3) + 1; + STRLEN fudge = SvPOK(tmpForm) + ? (SvCUR(tmpForm) * (IN_BYTES ? 1 : 3) + 1) : 0; bool item_is_utf8 = FALSE; bool targ_is_utf8 = FALSE; SV * nsv = Nullsv; @@ -1722,11 +1737,22 @@ PP(pp_enteriter) (void) SvPV(right,n_a); } } + else if (PL_op->op_private & OPpITER_REVERSED) { + cx->blk_loop.itermax = -1; + cx->blk_loop.iterix = AvFILL(cx->blk_loop.iterary); + + } } else { cx->blk_loop.iterary = PL_curstack; AvFILLp(PL_curstack) = SP - PL_stack_base; - cx->blk_loop.iterix = MARK - PL_stack_base; + if (PL_op->op_private & OPpITER_REVERSED) { + cx->blk_loop.itermax = MARK - PL_stack_base; + cx->blk_loop.iterix = cx->blk_oldsp; + } + else { + cx->blk_loop.iterix = MARK - PL_stack_base; + } } RETURN; @@ -2105,7 +2131,6 @@ PP(pp_goto) char *label; int do_dump = (PL_op->op_type == OP_DUMP); static char must_have_label[] = "goto must have label"; - AV *oldav = Nullav; label = 0; if (PL_op->op_flags & OPf_STACKED) { @@ -2120,6 +2145,7 @@ PP(pp_goto) SV** mark; I32 items = 0; I32 oldsave; + bool reified = 0; retry: if (!CvROOT(cv) && !CvXSUB(cv)) { @@ -2152,30 +2178,27 @@ PP(pp_goto) TOPBLOCK(cx); if (CxREALEVAL(cx)) DIE(aTHX_ "Can't goto subroutine from an eval-string"); - mark = PL_stack_sp; if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) { /* put @_ back onto stack */ AV* av = cx->blk_sub.argarray; items = AvFILLp(av) + 1; - PL_stack_sp++; - EXTEND(PL_stack_sp, items); /* @_ could have been extended. */ - Copy(AvARRAY(av), PL_stack_sp, items, SV*); - PL_stack_sp += items; + EXTEND(SP, items+1); /* @_ could have been extended. */ + Copy(AvARRAY(av), SP + 1, items, SV*); #ifndef USE_5005THREADS SvREFCNT_dec(GvAV(PL_defgv)); GvAV(PL_defgv) = cx->blk_sub.savearray; #endif /* USE_5005THREADS */ + CLEAR_ARGARRAY(av); /* abandon @_ if it got reified */ if (AvREAL(av)) { - oldav = av; /* delay until return */ + reified = 1; + SvREFCNT_dec(av); av = newAV(); av_extend(av, items-1); AvFLAGS(av) = AVf_REIFY; PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av); } - else - CLEAR_ARGARRAY(av); } else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */ AV* av; @@ -2185,11 +2208,11 @@ PP(pp_goto) av = GvAV(PL_defgv); #endif items = AvFILLp(av) + 1; - PL_stack_sp++; - EXTEND(PL_stack_sp, items); /* @_ could have been extended. */ - Copy(AvARRAY(av), PL_stack_sp, items, SV*); - PL_stack_sp += items; + EXTEND(SP, items+1); /* @_ could have been extended. */ + Copy(AvARRAY(av), SP + 1, items, SV*); } + mark = SP; + SP += items; if (CxTYPE(cx) == CXt_SUB && !(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) SvREFCNT_dec(cx->blk_sub.cv); @@ -2198,11 +2221,13 @@ PP(pp_goto) /* Now do some callish stuff. */ SAVETMPS; - /* For reified @_, delay freeing till return from new sub */ - if (oldav) - SAVEFREESV((SV*)oldav); SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */ if (CvXSUB(cv)) { + if (reified) { + I32 index; + for (index=0; index<items; index++) + sv_2mortal(SP[-index]); + } #ifdef PERL_XSUB_OLDSTYLE if (CvOLDSTYLE(cv)) { I32 (*fp3)(int,int,int); @@ -2222,9 +2247,9 @@ PP(pp_goto) SV **newsp; I32 gimme; - PL_stack_sp--; /* There is no cv arg. */ /* Push a mark for the start of arglist */ PUSHMARK(mark); + PUTBACK; (void)(*CvXSUB(cv))(aTHX_ cv); /* Pop the current context like a decent sub should */ POPBLOCK(cx, PL_curpm); @@ -2280,7 +2305,6 @@ PP(pp_goto) #endif /* USE_5005THREADS */ CX_CURPAD_SAVE(cx->blk_sub); cx->blk_sub.argarray = av; - ++mark; if (items >= AvMAX(av) + 1) { ary = AvALLOC(av); @@ -2295,9 +2319,15 @@ PP(pp_goto) SvPVX(av) = (char*)ary; } } + ++mark; Copy(mark,AvARRAY(av),items,SV*); AvFILLp(av) = items - 1; assert(!AvREAL(av)); + if (reified) { + /* transfer 'ownership' of refcnts to new @_ */ + AvREAL_on(av); + AvREIFY_off(av); + } while (items--) { if (*mark) SvTEMP_off(*mark); diff --git a/gnu/usr.bin/perl/pp_hot.c b/gnu/usr.bin/perl/pp_hot.c index e016416a8e2..4ac60c51ba0 100644 --- a/gnu/usr.bin/perl/pp_hot.c +++ b/gnu/usr.bin/perl/pp_hot.c @@ -16,6 +16,19 @@ * Fire, Foes! Awake! */ +/* This file contains 'hot' pp ("push/pop") functions that + * execute the opcodes that make up a perl program. A typical pp function + * expects to find its arguments on the stack, and usually pushes its + * results onto the stack, hence the 'pp' terminology. Each OP structure + * contains a pointer to the relevant pp_foo() function. + * + * By 'hot', we mean common ops whose execution speed is critical. + * By gathering them together into a single file, we encourage + * CPU cache hits on hot code. Also it could be taken as a warning not to + * change any code in this file unless you're sure it won't affect + * performance. + */ + #include "EXTERN.h" #define PERL_IN_PP_HOT_C #include "perl.h" @@ -235,7 +248,7 @@ PP(pp_eq) { dSP; tryAMAGICbinSET(eq,0); #ifndef NV_PRESERVES_UV - if (SvROK(TOPs) && SvROK(TOPm1s)) { + if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { SP--; SETs(boolSV(SvRV(TOPs) == SvRV(TOPp1s))); RETURN; @@ -1542,7 +1555,7 @@ Perl_do_readline(pTHX) /* undef TARG, and push that undefined value */ if (type != OP_RCATLINE) { SV_CHECK_THINKFIRST(TARG); - (void)SvOK_off(TARG); + SvOK_off(TARG); } PUSHTARG; } @@ -1608,7 +1621,7 @@ Perl_do_readline(pTHX) if (gimme == G_SCALAR) { if (type != OP_RCATLINE) { SV_CHECK_THINKFIRST(TARG); - (void)SvOK_off(TARG); + SvOK_off(TARG); } SPAGAIN; PUSHTARG; @@ -1908,19 +1921,39 @@ PP(pp_iter) } /* iterate array */ - if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp : AvFILL(av))) - RETPUSHNO; + if (PL_op->op_private & OPpITER_REVERSED) { + /* In reverse, use itermax as the min :-) */ + if (cx->blk_loop.iterix <= cx->blk_loop.itermax) + RETPUSHNO; - if (SvMAGICAL(av) || AvREIFY(av)) { - SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE); - if (svp) - sv = *svp; - else - sv = Nullsv; + if (SvMAGICAL(av) || AvREIFY(av)) { + SV **svp = av_fetch(av, cx->blk_loop.iterix--, FALSE); + if (svp) + sv = *svp; + else + sv = Nullsv; + } + else { + sv = AvARRAY(av)[cx->blk_loop.iterix--]; + } } else { - sv = AvARRAY(av)[++cx->blk_loop.iterix]; + if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp : + AvFILL(av))) + RETPUSHNO; + + if (SvMAGICAL(av) || AvREIFY(av)) { + SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE); + if (svp) + sv = *svp; + else + sv = Nullsv; + } + else { + sv = AvARRAY(av)[++cx->blk_loop.iterix]; + } } + if (sv && SvREFCNT(sv) == 0) { *itersvp = Nullsv; Perl_croak(aTHX_ "Use of freed value in iteration"); @@ -2232,7 +2265,7 @@ PP(pp_subst) else sv_catpvn(dstr, s, strend - s); - (void)SvOOK_off(TARG); + SvOOK_off(TARG); if (SvLEN(TARG)) Safefree(SvPVX(TARG)); SvPVX(TARG) = SvPVX(dstr); @@ -3045,7 +3078,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what) if (SvTYPE(sv) < SVt_RV) sv_upgrade(sv, SVt_RV); else if (SvTYPE(sv) >= SVt_PV) { - (void)SvOOK_off(sv); + SvOOK_off(sv); Safefree(SvPVX(sv)); SvLEN(sv) = SvCUR(sv) = 0; } diff --git a/gnu/usr.bin/perl/pp_sys.c b/gnu/usr.bin/perl/pp_sys.c index d2100496c36..393cbf8154a 100644 --- a/gnu/usr.bin/perl/pp_sys.c +++ b/gnu/usr.bin/perl/pp_sys.c @@ -15,6 +15,15 @@ * a rumour and a trouble as of great engines throbbing and labouring. */ +/* This file contains system pp ("push/pop") functions that + * execute the opcodes that make up a perl program. A typical pp function + * expects to find its arguments on the stack, and usually pushes its + * results onto the stack, hence the 'pp' terminology. Each OP structure + * contains a pointer to the relevant pp_foo() function. + * + * By 'system', we mean ops which interact with the OS, such as pp_open(). + */ + #include "EXTERN.h" #define PERL_IN_PP_SYS_C #include "perl.h" @@ -1656,7 +1665,10 @@ PP(pp_sysread) } if (DO_UTF8(bufsv)) { /* convert offset-as-chars to offset-as-bytes */ - offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer; + if (offset >= (int)blen) + offset += SvCUR(bufsv) - blen; + else + offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer; } more_bytes: bufsize = SvCUR(bufsv); diff --git a/gnu/usr.bin/perl/proto.h b/gnu/usr.bin/perl/proto.h index 4165f384c9f..686bb3bcbe4 100644 --- a/gnu/usr.bin/perl/proto.h +++ b/gnu/usr.bin/perl/proto.h @@ -1363,4 +1363,7 @@ STATIC HE* S_hv_fetch_common(pTHX_ HV* tb, SV* key_sv, const char* key, STRLEN k PERL_CALLCONV SV* Perl_hv_scalar(pTHX_ HV* hv); PERL_CALLCONV SV* Perl_magic_scalarpack(pTHX_ HV* hv, MAGIC* mg); +#if defined(DEBUGGING) +PERL_CALLCONV int Perl_get_debug_opts_flags(pTHX_ char **s, int flags); +#endif END_EXTERN_C diff --git a/gnu/usr.bin/perl/regcomp.c b/gnu/usr.bin/perl/regcomp.c index 62e5729b425..0762f551d30 100644 --- a/gnu/usr.bin/perl/regcomp.c +++ b/gnu/usr.bin/perl/regcomp.c @@ -5,6 +5,16 @@ * "A fair jaw-cracker dwarf-language must be." --Samwise Gamgee */ +/* This file contains functions for compiling a regular expression. See + * also regexec.c which funnily enough, contains functions for executing + * a regular expression. + * + * This file is also copied at build time to ext/re/re_comp.c, where + * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT. + * This causes the main functions to be compiled under new names and with + * debugging support added, which makes "use re 'debug'" work. + */ + /* NOTE: this is derived from Henry Spencer's regexp code, and should not * confused with the original package (see point 3 below). Thanks, Henry! */ diff --git a/gnu/usr.bin/perl/regexec.c b/gnu/usr.bin/perl/regexec.c index 58a62ab7ad0..b761752efdf 100644 --- a/gnu/usr.bin/perl/regexec.c +++ b/gnu/usr.bin/perl/regexec.c @@ -5,6 +5,17 @@ * "One Ring to rule them all, One Ring to find them..." */ +/* This file contains functions for executing a regular expression. See + * also regcomp.c which funnily enough, contains functions for compiling + * a regular expression. + * + * This file is also copied at build time to ext/re/re_exec.c, where + * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT. + * This causes the main functions to be compiled under new names and with + * debugging support added, which makes "use re 'debug'" work. + + */ + /* NOTE: this is derived from Henry Spencer's regexp code, and should not * confused with the original package (see point 3 below). Thanks, Henry! */ @@ -954,6 +965,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta char *m; STRLEN ln; STRLEN lnc; + register STRLEN uskip; unsigned int c1; unsigned int c2; char *e; @@ -964,7 +976,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta switch (OP(c)) { case ANYOF: if (do_utf8) { - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if ((ANYOF_FLAGS(c) & ANYOF_UNICODE) || !UTF8_IS_INVARIANT((U8)s[0]) ? reginclass(c, (U8*)s, 0, do_utf8) : @@ -976,7 +988,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } else tmp = 1; - s += UTF8SKIP(s); + s += uskip; } } else { @@ -1172,7 +1184,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta tmp = ((OP(c) == BOUND ? isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0); LOAD_UTF8_CHARCLASS(alnum,"a"); - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if (tmp == !(OP(c) == BOUND ? swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) : isALNUM_LC_utf8((U8*)s))) @@ -1181,7 +1193,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta if ((norun || regtry(prog, s))) goto got_it; } - s += UTF8SKIP(s); + s += uskip; } } else { @@ -1215,14 +1227,14 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta tmp = ((OP(c) == NBOUND ? isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0); LOAD_UTF8_CHARCLASS(alnum,"a"); - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if (tmp == !(OP(c) == NBOUND ? swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) : isALNUM_LC_utf8((U8*)s))) tmp = !tmp; else if ((norun || regtry(prog, s))) goto got_it; - s += UTF8SKIP(s); + s += uskip; } } else { @@ -1244,7 +1256,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta case ALNUM: if (do_utf8) { LOAD_UTF8_CHARCLASS(alnum,"a"); - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if (swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) { if (tmp && (norun || regtry(prog, s))) goto got_it; @@ -1253,7 +1265,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } else tmp = 1; - s += UTF8SKIP(s); + s += uskip; } } else { @@ -1273,7 +1285,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta case ALNUML: PL_reg_flags |= RF_tainted; if (do_utf8) { - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if (isALNUM_LC_utf8((U8*)s)) { if (tmp && (norun || regtry(prog, s))) goto got_it; @@ -1282,7 +1294,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } else tmp = 1; - s += UTF8SKIP(s); + s += uskip; } } else { @@ -1302,7 +1314,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta case NALNUM: if (do_utf8) { LOAD_UTF8_CHARCLASS(alnum,"a"); - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if (!swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) { if (tmp && (norun || regtry(prog, s))) goto got_it; @@ -1311,7 +1323,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } else tmp = 1; - s += UTF8SKIP(s); + s += uskip; } } else { @@ -1331,7 +1343,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta case NALNUML: PL_reg_flags |= RF_tainted; if (do_utf8) { - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if (!isALNUM_LC_utf8((U8*)s)) { if (tmp && (norun || regtry(prog, s))) goto got_it; @@ -1340,7 +1352,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } else tmp = 1; - s += UTF8SKIP(s); + s += uskip; } } else { @@ -1360,7 +1372,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta case SPACE: if (do_utf8) { LOAD_UTF8_CHARCLASS(space," "); - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8)) { if (tmp && (norun || regtry(prog, s))) goto got_it; @@ -1369,7 +1381,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } else tmp = 1; - s += UTF8SKIP(s); + s += uskip; } } else { @@ -1389,7 +1401,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta case SPACEL: PL_reg_flags |= RF_tainted; if (do_utf8) { - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) { if (tmp && (norun || regtry(prog, s))) goto got_it; @@ -1398,7 +1410,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } else tmp = 1; - s += UTF8SKIP(s); + s += uskip; } } else { @@ -1418,7 +1430,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta case NSPACE: if (do_utf8) { LOAD_UTF8_CHARCLASS(space," "); - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8))) { if (tmp && (norun || regtry(prog, s))) goto got_it; @@ -1427,7 +1439,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } else tmp = 1; - s += UTF8SKIP(s); + s += uskip; } } else { @@ -1447,7 +1459,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta case NSPACEL: PL_reg_flags |= RF_tainted; if (do_utf8) { - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) { if (tmp && (norun || regtry(prog, s))) goto got_it; @@ -1456,7 +1468,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } else tmp = 1; - s += UTF8SKIP(s); + s += uskip; } } else { @@ -1476,7 +1488,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta case DIGIT: if (do_utf8) { LOAD_UTF8_CHARCLASS(digit,"0"); - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if (swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) { if (tmp && (norun || regtry(prog, s))) goto got_it; @@ -1485,7 +1497,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } else tmp = 1; - s += UTF8SKIP(s); + s += uskip; } } else { @@ -1505,7 +1517,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta case DIGITL: PL_reg_flags |= RF_tainted; if (do_utf8) { - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if (isDIGIT_LC_utf8((U8*)s)) { if (tmp && (norun || regtry(prog, s))) goto got_it; @@ -1514,7 +1526,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } else tmp = 1; - s += UTF8SKIP(s); + s += uskip; } } else { @@ -1534,7 +1546,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta case NDIGIT: if (do_utf8) { LOAD_UTF8_CHARCLASS(digit,"0"); - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if (!swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) { if (tmp && (norun || regtry(prog, s))) goto got_it; @@ -1543,7 +1555,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } else tmp = 1; - s += UTF8SKIP(s); + s += uskip; } } else { @@ -1563,7 +1575,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta case NDIGITL: PL_reg_flags |= RF_tainted; if (do_utf8) { - while (s < strend) { + while (s + (uskip = UTF8SKIP(s)) <= strend) { if (!isDIGIT_LC_utf8((U8*)s)) { if (tmp && (norun || regtry(prog, s))) goto got_it; @@ -1572,7 +1584,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } else tmp = 1; - s += UTF8SKIP(s); + s += uskip; } } else { diff --git a/gnu/usr.bin/perl/run.c b/gnu/usr.bin/perl/run.c index 3d48139d883..a2059e2e5bb 100644 --- a/gnu/usr.bin/perl/run.c +++ b/gnu/usr.bin/perl/run.c @@ -8,6 +8,19 @@ * */ +/* This file contains the main Perl opcode execution loop. It just + * calls the pp_foo() function associated with each op, and expects that + * function to return a pointer to the next op to be executed, or null if + * it's the end of the sub or program or whatever. + * + * There is a similar loop in dump.c, Perl_runops_debug(), which does + * the same, but also checks for various debug flags each time round the + * loop. + * + * Why this function requires a file all of its own is anybody's guess. + * DAPM. + */ + #include "EXTERN.h" #define PERL_IN_RUN_C #include "perl.h" diff --git a/gnu/usr.bin/perl/scope.c b/gnu/usr.bin/perl/scope.c index d9034b72f40..9136df946d9 100644 --- a/gnu/usr.bin/perl/scope.c +++ b/gnu/usr.bin/perl/scope.c @@ -13,6 +13,13 @@ * levels..." */ +/* This file contains functions to manipulate several of Perl's stacks; + * in particular it contains code to push various types of things onto + * the savestack, then to pop them off and perform the correct restorative + * action for each one. This corresponds to the cleanup Perl does at + * each scope exit. + */ + #include "EXTERN.h" #define PERL_IN_SCOPE_C #include "perl.h" @@ -930,14 +937,8 @@ Perl_leave_scope(pTHX_ I32 base) break; case SVt_PVCV: Perl_croak(aTHX_ "panic: leave_scope pad code"); - case SVt_RV: - case SVt_IV: - case SVt_NV: - (void)SvOK_off(sv); - break; default: - (void)SvOK_off(sv); - (void)SvOOK_off(sv); + SvOK_off(sv); break; } } @@ -1045,6 +1046,15 @@ Perl_leave_scope(pTHX_ I32 base) AvARRAY((PAD*)ptr)[off] = (SV*)SSPOPPTR; } break; + case SAVEt_SAVESWITCHSTACK: + { + dSP; + AV* t = (AV*)SSPOPPTR; + AV* f = (AV*)SSPOPPTR; + SWITCHSTACK(t,f); + PL_curstackinfo->si_stack = f; + } + break; default: Perl_croak(aTHX_ "panic: leave_scope inconsistency"); } diff --git a/gnu/usr.bin/perl/scope.h b/gnu/usr.bin/perl/scope.h index 612de4aa14c..afe4de9a3a0 100644 --- a/gnu/usr.bin/perl/scope.h +++ b/gnu/usr.bin/perl/scope.h @@ -47,6 +47,7 @@ #define SAVEt_MORTALIZESV 36 #define SAVEt_SHARED_PVREF 37 #define SAVEt_BOOL 38 +#define SAVEt_SAVESWITCHSTACK 40 #ifndef SCOPE_SAVES_SIGNAL_MASK #define SCOPE_SAVES_SIGNAL_MASK 0 @@ -167,6 +168,16 @@ Closing bracket on a callback. See C<ENTER> and L<perlcall>. SSPUSHINT(SAVEt_COMPPAD); \ } STMT_END +#define SAVESWITCHSTACK(f,t) \ + STMT_START { \ + SSCHECK(3); \ + SSPUSHPTR((SV*)(f)); \ + SSPUSHPTR((SV*)(t)); \ + SSPUSHINT(SAVEt_SAVESWITCHSTACK); \ + SWITCHSTACK((f),(t)); \ + PL_curstackinfo->si_stack = (t); \ + } STMT_END + #ifdef USE_ITHREADS # define SAVECOPSTASH(c) SAVEPPTR(CopSTASHPV(c)) # define SAVECOPSTASH_FREE(c) SAVESHAREDPV(CopSTASHPV(c)) diff --git a/gnu/usr.bin/perl/sv.c b/gnu/usr.bin/perl/sv.c index 5ce1e59e9d8..63f9964a709 100644 --- a/gnu/usr.bin/perl/sv.c +++ b/gnu/usr.bin/perl/sv.c @@ -1283,6 +1283,7 @@ You generally want to use the C<SvUPGRADE> macro wrapper. See also C<svtype>. bool Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) { + char* pv = NULL; U32 cur = 0; U32 len = 0; @@ -1472,7 +1473,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) SvSTASH(sv) = stash; AvALLOC(sv) = 0; AvARYLEN(sv) = 0; - AvFLAGS(sv) = 0; + AvFLAGS(sv) = AVf_REAL; break; case SVt_PVHV: SvANY(sv) = new_XPVHV(); @@ -3252,9 +3253,8 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags) *lp = len; s = SvGROW(sv, len + 1); SvCUR_set(sv, len); - (void)strcpy(s, t); SvPOKp_on(sv); - return s; + return strcpy(s, t); } } @@ -3639,8 +3639,9 @@ function if the source SV needs to be reused. Does not handle 'set' magic. Loosely speaking, it performs a copy-by-value, obliterating any previous content of the destination. If the C<flags> parameter has the C<SV_GMAGIC> bit set, will C<mg_get> on -C<ssv> if appropriate, else not. C<sv_setsv> and C<sv_setsv_nomg> are -implemented in terms of this function. +C<ssv> if appropriate, else not. If the C<flags> parameter has the +C<NOSTEAL> bit set then the buffers of temps will not be stolen. <sv_setsv> +and C<sv_setsv_nomg> are implemented in terms of this function. You probably want to use one of the assortment of wrappers, such as C<SvSetSV>, C<SvSetSV_nosteal>, C<SvSetMagicSV> and @@ -4003,6 +4004,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) if (SvTEMP(sstr) && /* slated for free anyway? */ SvREFCNT(sstr) == 1 && /* and no other references to it? */ + (!(flags & SV_NOSTEAL)) && /* and we're allowed to steal temps */ !(sflags & SVf_OOK) && /* and not involved in OOK hack? */ SvLEN(sstr) && /* and really is a string */ /* and won't be needed again, potentially */ @@ -4567,18 +4569,18 @@ Perl_newSV(pTHX_ STRLEN len) =for apidoc sv_magicext Adds magic to an SV, upgrading it if necessary. Applies the -supplied vtable and returns pointer to the magic added. +supplied vtable and returns a pointer to the magic added. -Note that sv_magicext will allow things that sv_magic will not. -In particular you can add magic to SvREADONLY SVs and and more than -one instance of the same 'how' +Note that C<sv_magicext> will allow things that C<sv_magic> will not. +In particular, you can add magic to SvREADONLY SVs, and add more than +one instance of the same 'how'. -I C<namelen> is greater then zero then a savepvn() I<copy> of C<name> is stored, -if C<namelen> is zero then C<name> is stored as-is and - as another special -case - if C<(name && namelen == HEf_SVKEY)> then C<name> is assumed to contain -an C<SV*> and has its REFCNT incremented +If C<namlen> is greater than zero then a C<savepvn> I<copy> of C<name> is +stored, if C<namlen> is zero then C<name> is stored as-is and - as another +special case - if C<(name && namlen == HEf_SVKEY)> then C<name> is assumed +to contain an C<SV*> and is stored as-is with its REFCNT incremented. -(This is now used as a subroutine by sv_magic.) +(This is now used as a subroutine by C<sv_magic>.) =cut */ @@ -4657,6 +4659,9 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable, Adds magic to an SV. First upgrades C<sv> to type C<SVt_PVMG> if necessary, then adds a new magic item of type C<how> to the head of the magic list. +See C<sv_magicext> (which C<sv_magic> now calls) for a description of the +handling of the C<name> and C<namlen> arguments. + =cut */ @@ -5212,7 +5217,7 @@ Perl_sv_clear(pTHX_ register SV *sv) case SVt_PVNV: case SVt_PVIV: freescalar: - (void)SvOOK_off(sv); + SvOOK_off(sv); /* FALL THROUGH */ case SVt_PV: case SVt_RV: @@ -7132,7 +7137,7 @@ Perl_sv_reset(pTHX_ register char *s, HV *stash) sv_unref(sv); continue; } - (void)SvOK_off(sv); + SvOK_off(sv); if (SvTYPE(sv) >= SVt_PV) { SvCUR_set(sv, 0); if (SvPVX(sv) != Nullch) @@ -7732,14 +7737,14 @@ Perl_newSVrv(pTHX_ SV *rv, const char *classname) if (SvTYPE(rv) < SVt_RV) sv_upgrade(rv, SVt_RV); else if (SvTYPE(rv) > SVt_RV) { - (void)SvOOK_off(rv); + SvOOK_off(rv); if (SvPVX(rv) && SvLEN(rv)) Safefree(SvPVX(rv)); SvCUR_set(rv, 0); SvLEN_set(rv, 0); } - (void)SvOK_off(rv); + SvOK_off(rv); SvRV(rv) = sv; SvROK_on(rv); @@ -8109,8 +8114,8 @@ Perl_sv_setpvf_mg_nocontext(SV *sv, const char* pat, ...) /* =for apidoc sv_setpvf -Processes its arguments like C<sprintf> and sets an SV to the formatted -output. Does not handle 'set' magic. See C<sv_setpvf_mg>. +Works like C<sv_catpvf> but copies the text into the SV instead of +appending it. Does not handle 'set' magic. See C<sv_setpvf_mg>. =cut */ @@ -8124,7 +8129,16 @@ Perl_sv_setpvf(pTHX_ SV *sv, const char* pat, ...) va_end(args); } -/* backend for C<sv_setpvf> and C<sv_setpvf_nocontext> */ +/* +=for apidoc sv_vsetpvf + +Works like C<sv_vcatpvf> but copies the text into the SV instead of +appending it. Does not handle 'set' magic. See C<sv_vsetpvf_mg>. + +Usually used via its frontend C<sv_setpvf>. + +=cut +*/ void Perl_sv_vsetpvf(pTHX_ SV *sv, const char* pat, va_list* args) @@ -8149,7 +8163,15 @@ Perl_sv_setpvf_mg(pTHX_ SV *sv, const char* pat, ...) va_end(args); } -/* backend for C<sv_setpvf_mg> C<setpvf_mg_nocontext> */ +/* +=for apidoc sv_vsetpvf_mg + +Like C<sv_vsetpvf>, but also handles 'set' magic. + +Usually used via its frontend C<sv_setpvf_mg>. + +=cut +*/ void Perl_sv_vsetpvf_mg(pTHX_ SV *sv, const char* pat, va_list* args) @@ -8198,9 +8220,8 @@ Processes its arguments like C<sprintf> and appends the formatted output to an SV. If the appended data contains "wide" characters (including, but not limited to, SVs with a UTF-8 PV formatted with %s, and characters >255 formatted with %c), the original SV might get -upgraded to UTF-8. Handles 'get' magic, but not 'set' magic. -C<SvSETMAGIC()> must typically be called after calling this function -to handle 'set' magic. +upgraded to UTF-8. Handles 'get' magic, but not 'set' magic. See +C<sv_catpvf_mg>. =cut */ @@ -8213,7 +8234,16 @@ Perl_sv_catpvf(pTHX_ SV *sv, const char* pat, ...) va_end(args); } -/* backend for C<sv_catpvf> and C<catpvf_mg_nocontext> */ +/* +=for apidoc sv_vcatpvf + +Processes its arguments like C<vsprintf> and appends the formatted output +to an SV. Does not handle 'set' magic. See C<sv_vcatpvf_mg>. + +Usually used via its frontend C<sv_catpvf>. + +=cut +*/ void Perl_sv_vcatpvf(pTHX_ SV *sv, const char* pat, va_list* args) @@ -8238,7 +8268,15 @@ Perl_sv_catpvf_mg(pTHX_ SV *sv, const char* pat, ...) va_end(args); } -/* backend for C<catpvf_mg> and C<catpvf_mg_nocontext> */ +/* +=for apidoc sv_vcatpvf_mg + +Like C<sv_vcatpvf>, but also handles 'set' magic. + +Usually used via its frontend C<sv_catpvf_mg>. + +=cut +*/ void Perl_sv_vcatpvf_mg(pTHX_ SV *sv, const char* pat, va_list* args) @@ -8250,10 +8288,10 @@ Perl_sv_vcatpvf_mg(pTHX_ SV *sv, const char* pat, va_list* args) /* =for apidoc sv_vsetpvfn -Works like C<vcatpvfn> but copies the text into the SV instead of +Works like C<sv_vcatpvfn> but copies the text into the SV instead of appending it. -Usually used via one of its frontends C<sv_setpvf> and C<sv_setpvf_mg>. +Usually used via one of its frontends C<sv_vsetpvf> and C<sv_vsetpvf_mg>. =cut */ @@ -8318,7 +8356,7 @@ missing (NULL). When running with taint checks enabled, indicates via C<maybe_tainted> if results are untrustworthy (often due to the use of locales). -Usually used via one of its frontends C<sv_catpvf> and C<sv_catpvf_mg>. +Usually used via one of its frontends C<sv_vcatpvf> and C<sv_vcatpvf_mg>. =cut */ @@ -10768,19 +10806,23 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, SvANY(&PL_sv_no) = new_XPVNV(); SvREFCNT(&PL_sv_no) = (~(U32)0)/2; - SvFLAGS(&PL_sv_no) = SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV; + SvFLAGS(&PL_sv_no) = SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK + |SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV; SvPVX(&PL_sv_no) = SAVEPVN(PL_No, 0); SvCUR(&PL_sv_no) = 0; SvLEN(&PL_sv_no) = 1; + SvIVX(&PL_sv_no) = 0; SvNVX(&PL_sv_no) = 0; ptr_table_store(PL_ptr_table, &proto_perl->Isv_no, &PL_sv_no); SvANY(&PL_sv_yes) = new_XPVNV(); SvREFCNT(&PL_sv_yes) = (~(U32)0)/2; - SvFLAGS(&PL_sv_yes) = SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV; + SvFLAGS(&PL_sv_yes) = SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK + |SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV; SvPVX(&PL_sv_yes) = SAVEPVN(PL_Yes, 1); SvCUR(&PL_sv_yes) = 1; SvLEN(&PL_sv_yes) = 2; + SvIVX(&PL_sv_yes) = 1; SvNVX(&PL_sv_yes) = 1; ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes); @@ -11498,8 +11540,9 @@ Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding) FREETMPS; LEAVE; SvUTF8_on(sv); + return SvPVX(sv); } - return SvPVX(sv); + return SvPOKp(sv) ? SvPVX(sv) : NULL; } /* diff --git a/gnu/usr.bin/perl/sv.h b/gnu/usr.bin/perl/sv.h index 3f001a0c036..b874200eecb 100644 --- a/gnu/usr.bin/perl/sv.h +++ b/gnu/usr.bin/perl/sv.h @@ -581,9 +581,9 @@ Set the length of the string which is in the SV. See C<SvCUR>. #define SvIOK_on(sv) ((void)SvOOK_off(sv), \ SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) #define SvIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVp_IOK|SVf_IVisUV)) -#define SvIOK_only(sv) ((void)SvOK_off(sv), \ +#define SvIOK_only(sv) (SvOK_off(sv), \ SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) -#define SvIOK_only_UV(sv) ((void)SvOK_off_exc_UV(sv), \ +#define SvIOK_only_UV(sv) (SvOK_off_exc_UV(sv), \ SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) #define SvIOK_UV(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) \ @@ -600,7 +600,7 @@ Set the length of the string which is in the SV. See C<SvCUR>. #define SvNOK(sv) (SvFLAGS(sv) & SVf_NOK) #define SvNOK_on(sv) (SvFLAGS(sv) |= (SVf_NOK|SVp_NOK)) #define SvNOK_off(sv) (SvFLAGS(sv) &= ~(SVf_NOK|SVp_NOK)) -#define SvNOK_only(sv) ((void)SvOK_off(sv), \ +#define SvNOK_only(sv) (SvOK_off(sv), \ SvFLAGS(sv) |= (SVf_NOK|SVp_NOK)) /* @@ -640,7 +640,7 @@ and leaves the UTF-8 status as it was. #define SvOOK(sv) (SvFLAGS(sv) & SVf_OOK) #define SvOOK_on(sv) ((void)SvIOK_off(sv), SvFLAGS(sv) |= SVf_OOK) -#define SvOOK_off(sv) (SvOOK(sv) && sv_backoff(sv)) +#define SvOOK_off(sv) ((void)(SvOOK(sv) && sv_backoff(sv))) #define SvFAKE(sv) (SvFLAGS(sv) & SVf_FAKE) #define SvFAKE_on(sv) (SvFLAGS(sv) |= SVf_FAKE) @@ -954,6 +954,15 @@ COW) Returns a boolean indicating whether the SV is Copy-On-Write shared hash key scalar. +=for apidoc Am|void|sv_catpvn_nomg|SV* sv|const char* ptr|STRLEN len +Like C<sv_catpvn> but doesn't process magic. + +=for apidoc Am|void|sv_setsv_nomg|SV* dsv|SV* ssv +Like C<sv_setsv> but doesn't process magic. + +=for apidoc Am|void|sv_catsv_nomg|SV* dsv|SV* ssv +Like C<sv_catsv> but doesn't process magic. + =cut */ @@ -1101,6 +1110,7 @@ scalar. #define SV_GMAGIC 2 #define SV_COW_DROP_PV 4 /* Unused in Perl 5.8.x */ #define SV_UTF8_NO_ENCODING 8 +#define SV_NOSTEAL 16 /* all these 'functions' are now just macros */ @@ -1169,7 +1179,7 @@ ssv. May evaluate arguments more than once. Like C<SvSetSV>, but does any set magic required afterwards. =for apidoc Am|void|SvSetMagicSV_nosteal|SV* dsv|SV* ssv -Like C<SvSetMagicSV>, but does any set magic required afterwards. +Like C<SvSetSV_nosteal>, but does any set magic required afterwards. =for apidoc Am|void|SvSHARE|SV* sv Arranges for sv to be shared between threads if a suitable module @@ -1211,10 +1221,7 @@ Returns a pointer to the character buffer. #define SvSetSV_nosteal_and(dst,src,finally) \ STMT_START { \ if ((dst) != (src)) { \ - U32 tMpF = SvFLAGS(src) & SVs_TEMP; \ - SvTEMP_off(src); \ - sv_setsv(dst, src); \ - SvFLAGS(src) |= tMpF; \ + sv_setsv_flags(dst, src, SV_GMAGIC | SV_NOSTEAL); \ finally; \ } \ } STMT_END diff --git a/gnu/usr.bin/perl/t/TEST b/gnu/usr.bin/perl/t/TEST index 12985b77220..ea9a2413089 100644 --- a/gnu/usr.bin/perl/t/TEST +++ b/gnu/usr.bin/perl/t/TEST @@ -1,7 +1,9 @@ #!./perl # This is written in a peculiar style, since we're trying to avoid -# most of the constructs we'll be testing for. +# most of the constructs we'll be testing for. (This comment is +# probably obsolete on the avoidance side, though still currrent +# on the peculiarity side.) $| = 1; @@ -20,7 +22,8 @@ if ($#ARGV >= 0) { $core = 1 if $1 eq 'core'; $verbose = 1 if $1 eq 'v'; $torture = 1 if $1 eq 'torture'; - $with_utf= 1 if $1 eq 'utf8'; + $with_utf8 = 1 if $1 eq 'utf8'; + $with_utf16 = 1 if $1 eq 'utf16'; $bytecompile = 1 if $1 eq 'bytecompile'; $compile = 1 if $1 eq 'compile'; $taintwarn = 1 if $1 eq 'taintwarn'; @@ -134,6 +137,32 @@ elsif( $compile ) { elsif( $bytecompile ) { _testprogs('bytecompile', '', @ARGV); } +elsif ($with_utf16) { + for my $e (0, 1) { + for my $b (0, 1) { + print STDERR "# ENDIAN $e BOM $b\n"; + my @UARGV; + for my $a (@ARGV) { + my $u = $a . "." . ($e ? "l" : "b") . "e" . ($b ? "b" : ""); + my $f = $e ? "v" : "n"; + push @UARGV, $u; + unlink($u); + if (open(A, $a)) { + if (open(U, ">$u")) { + print U pack("$f", 0xFEFF) if $b; + while (<A>) { + print U pack("$f*", unpack("C*", $_)); + } + close(A); + } + close(B); + } + } + _testprogs('perl', '', @UARGV); + unlink(@UARGV); + } + } +} else { _testprogs('compile', '', @ARGV) if -e "../testcompile"; _testprogs('perl', '', @ARGV); @@ -219,6 +248,9 @@ EOT open(SCRIPT,"<$test") or die "Can't run $test.\n"; $_ = <SCRIPT>; close(SCRIPT) unless ($type eq 'deparse'); + if ($with_utf16) { + $_ =~ tr/\0//d; + } if (/#!.*\bperl.*\s-\w*([tT])/) { $switch = qq{"-$1"}; } @@ -243,7 +275,7 @@ EOT close(SCRIPT); } - my $utf = $with_utf ? '-I../lib -Mutf8' : ''; + my $utf8 = $with_utf8 ? '-I../lib -Mutf8' : ''; my $testswitch = '-I. -MTestInit'; # -T will strict . from @INC if ($type eq 'deparse') { my $deparse = @@ -275,7 +307,7 @@ EOT my $bytecompile = "$perl $testswitch $switch -I../lib $bswitch". "-o$test.plc $test 2>$null &&". - "$perl $testswitch $switch -I../lib $utf $test.plc |"; + "$perl $testswitch $switch -I../lib $utf8 $test.plc |"; open(RESULTS,$bytecompile) or print "can't byte-compile '$bytecompile': $!.\n"; } @@ -288,7 +320,7 @@ EOT . "--num-callers=50 --logfile-fd=3 $perl"; $redir = "3>$valgrind_log"; } - my $run = "$perl" . _quote_args("$testswitch $switch $utf") . " $test $redir|"; + my $run = "$perl" . _quote_args("$testswitch $switch $utf8") . " $test $redir|"; open(RESULTS,$run) or print "can't run '$run': $!.\n"; } else { @@ -296,7 +328,7 @@ EOT my $pl2c = "$testswitch -I../lib ../utils/perlcc --testsuite " . # -O9 for good measure, -fcog is broken ATM "$switch -Wb=-O9,-fno-cog -L .. " . - "-I \".. ../lib/CORE\" $args $utf $test -o "; + "-I \".. ../lib/CORE\" $args $utf8 $test -o "; if( $^O eq 'MSWin32' ) { $test_executable = "$test.exe"; diff --git a/gnu/usr.bin/perl/t/cmd/for.t b/gnu/usr.bin/perl/t/cmd/for.t index 27fb5a25178..0814e7bb236 100644 --- a/gnu/usr.bin/perl/t/cmd/for.t +++ b/gnu/usr.bin/perl/t/cmd/for.t @@ -1,6 +1,6 @@ #!./perl -print "1..14\n"; +print "1..78\n"; for ($i = 0; $i <= 10; $i++) { $x[$i] = $i; @@ -95,3 +95,365 @@ print $@ =~ /Use of freed value in iteration/ ? "ok" : "not ok", " 13\n"; print $x == 1 ? "ok" : "not ok", " 14 - double destroy, x=$x\n"; } +# A lot of tests to check that reversed for works. +my $test = 14; +sub is { + my ($got, $expected, $name) = @_; + ++$test; + if ($got eq $expected) { + print "ok $test # $name\n"; + return 1; + } + print "not ok $test # $name\n"; + print "# got '$got', expected '$expected'\n"; + return 0; +} + +@array = ('A', 'B', 'C'); +for (@array) { + $r .= $_; +} +is ($r, 'ABC', 'Forwards for array'); +$r = ''; +for (1,2,3) { + $r .= $_; +} +is ($r, '123', 'Forwards for list'); +$r = ''; +for (map {$_} @array) { + $r .= $_; +} +is ($r, 'ABC', 'Forwards for array via map'); +$r = ''; +for (map {$_} 1,2,3) { + $r .= $_; +} +is ($r, '123', 'Forwards for list via map'); + +$r = ''; +for (reverse @array) { + $r .= $_; +} +is ($r, 'CBA', 'Reverse for array'); +$r = ''; +for (reverse 1,2,3) { + $r .= $_; +} +is ($r, '321', 'Reverse for list'); +$r = ''; +for (reverse map {$_} @array) { + $r .= $_; +} +is ($r, 'CBA', 'Reverse for array via map'); +$r = ''; +for (reverse map {$_} 1,2,3) { + $r .= $_; +} +is ($r, '321', 'Reverse for list via map'); + +$r = ''; +for my $i (@array) { + $r .= $i; +} +is ($r, 'ABC', 'Forwards for array with var'); +$r = ''; +for my $i (1,2,3) { + $r .= $i; +} +is ($r, '123', 'Forwards for list with var'); +$r = ''; +for my $i (map {$_} @array) { + $r .= $i; +} +is ($r, 'ABC', 'Forwards for array via map with var'); +$r = ''; +for my $i (map {$_} 1,2,3) { + $r .= $i; +} +is ($r, '123', 'Forwards for list via map with var'); + +$r = ''; +for my $i (reverse @array) { + $r .= $i; +} +is ($r, 'CBA', 'Reverse for array with var'); +$r = ''; +for my $i (reverse 1,2,3) { + $r .= $i; +} +is ($r, '321', 'Reverse for list with var'); +$r = ''; +for my $i (reverse map {$_} @array) { + $r .= $i; +} +is ($r, 'CBA', 'Reverse for array via map with var'); +$r = ''; +for my $i (reverse map {$_} 1,2,3) { + $r .= $i; +} +is ($r, '321', 'Reverse for list via map with var'); + +# For some reason the generate optree is different when $_ is implicit. +$r = ''; +for $_ (@array) { + $r .= $_; +} +is ($r, 'ABC', 'Forwards for array with explicit $_'); +$r = ''; +for $_ (1,2,3) { + $r .= $_; +} +is ($r, '123', 'Forwards for list with explicit $_'); +$r = ''; +for $_ (map {$_} @array) { + $r .= $_; +} +is ($r, 'ABC', 'Forwards for array via map with explicit $_'); +$r = ''; +for $_ (map {$_} 1,2,3) { + $r .= $_; +} +is ($r, '123', 'Forwards for list via map with explicit $_'); + +$r = ''; +for $_ (reverse @array) { + $r .= $_; +} +is ($r, 'CBA', 'Reverse for array with explicit $_'); +$r = ''; +for $_ (reverse 1,2,3) { + $r .= $_; +} +is ($r, '321', 'Reverse for list with explicit $_'); +$r = ''; +for $_ (reverse map {$_} @array) { + $r .= $_; +} +is ($r, 'CBA', 'Reverse for array via map with explicit $_'); +$r = ''; +for $_ (reverse map {$_} 1,2,3) { + $r .= $_; +} +is ($r, '321', 'Reverse for list via map with explicit $_'); + +# I don't think that my is that different from our in the optree. But test a +# few: +$r = ''; +for our $i (reverse @array) { + $r .= $i; +} +is ($r, 'CBA', 'Reverse for array with our var'); +$r = ''; +for our $i (reverse 1,2,3) { + $r .= $i; +} +is ($r, '321', 'Reverse for list with our var'); +$r = ''; +for our $i (reverse map {$_} @array) { + $r .= $i; +} +is ($r, 'CBA', 'Reverse for array via map with our var'); +$r = ''; +for our $i (reverse map {$_} 1,2,3) { + $r .= $i; +} +is ($r, '321', 'Reverse for list via map with our var'); + + +$r = ''; +for (1, reverse @array) { + $r .= $_; +} +is ($r, '1CBA', 'Reverse for array with leading value'); +$r = ''; +for ('A', reverse 1,2,3) { + $r .= $_; +} +is ($r, 'A321', 'Reverse for list with leading value'); +$r = ''; +for (1, reverse map {$_} @array) { + $r .= $_; +} +is ($r, '1CBA', 'Reverse for array via map with leading value'); +$r = ''; +for ('A', reverse map {$_} 1,2,3) { + $r .= $_; +} +is ($r, 'A321', 'Reverse for list via map with leading value'); + +$r = ''; +for (reverse (@array), 1) { + $r .= $_; +} +is ($r, 'CBA1', 'Reverse for array with trailing value'); +$r = ''; +for (reverse (1,2,3), 'A') { + $r .= $_; +} +is ($r, '321A', 'Reverse for list with trailing value'); +$r = ''; +for (reverse (map {$_} @array), 1) { + $r .= $_; +} +is ($r, 'CBA1', 'Reverse for array via map with trailing value'); +$r = ''; +for (reverse (map {$_} 1,2,3), 'A') { + $r .= $_; +} +is ($r, '321A', 'Reverse for list via map with trailing value'); + + +$r = ''; +for $_ (1, reverse @array) { + $r .= $_; +} +is ($r, '1CBA', 'Reverse for array with leading value with explicit $_'); +$r = ''; +for $_ ('A', reverse 1,2,3) { + $r .= $_; +} +is ($r, 'A321', 'Reverse for list with leading value with explicit $_'); +$r = ''; +for $_ (1, reverse map {$_} @array) { + $r .= $_; +} +is ($r, '1CBA', + 'Reverse for array via map with leading value with explicit $_'); +$r = ''; +for $_ ('A', reverse map {$_} 1,2,3) { + $r .= $_; +} +is ($r, 'A321', 'Reverse for list via map with leading value with explicit $_'); + +$r = ''; +for $_ (reverse (@array), 1) { + $r .= $_; +} +is ($r, 'CBA1', 'Reverse for array with trailing value with explicit $_'); +$r = ''; +for $_ (reverse (1,2,3), 'A') { + $r .= $_; +} +is ($r, '321A', 'Reverse for list with trailing value with explicit $_'); +$r = ''; +for $_ (reverse (map {$_} @array), 1) { + $r .= $_; +} +is ($r, 'CBA1', + 'Reverse for array via map with trailing value with explicit $_'); +$r = ''; +for $_ (reverse (map {$_} 1,2,3), 'A') { + $r .= $_; +} +is ($r, '321A', + 'Reverse for list via map with trailing value with explicit $_'); + +$r = ''; +for my $i (1, reverse @array) { + $r .= $i; +} +is ($r, '1CBA', 'Reverse for array with leading value and var'); +$r = ''; +for my $i ('A', reverse 1,2,3) { + $r .= $i; +} +is ($r, 'A321', 'Reverse for list with leading value and var'); +$r = ''; +for my $i (1, reverse map {$_} @array) { + $r .= $i; +} +is ($r, '1CBA', 'Reverse for array via map with leading value and var'); +$r = ''; +for my $i ('A', reverse map {$_} 1,2,3) { + $r .= $i; +} +is ($r, 'A321', 'Reverse for list via map with leading value and var'); + +$r = ''; +for my $i (reverse (@array), 1) { + $r .= $i; +} +is ($r, 'CBA1', 'Reverse for array with trailing value and var'); +$r = ''; +for my $i (reverse (1,2,3), 'A') { + $r .= $i; +} +is ($r, '321A', 'Reverse for list with trailing value and var'); +$r = ''; +for my $i (reverse (map {$_} @array), 1) { + $r .= $i; +} +is ($r, 'CBA1', 'Reverse for array via map with trailing value and var'); +$r = ''; +for my $i (reverse (map {$_} 1,2,3), 'A') { + $r .= $i; +} +is ($r, '321A', 'Reverse for list via map with trailing value and var'); + + +$r = ''; +for (reverse 1, @array) { + $r .= $_; +} +is ($r, 'CBA1', 'Reverse for value and array'); +$r = ''; +for (reverse map {$_} 1, @array) { + $r .= $_; +} +is ($r, 'CBA1', 'Reverse for value and array via map'); + +$r = ''; +for (reverse (@array, 1)) { + $r .= $_; +} +is ($r, '1CBA', 'Reverse for array and value'); +$r = ''; +for (reverse (map {$_} @array, 1)) { + $r .= $_; +} +is ($r, '1CBA', 'Reverse for array and value via map'); + +$r = ''; +for $_ (reverse 1, @array) { + $r .= $_; +} +is ($r, 'CBA1', 'Reverse for value and array with explicit $_'); +$r = ''; +for $_ (reverse map {$_} 1, @array) { + $r .= $_; +} +is ($r, 'CBA1', 'Reverse for value and array via map with explicit $_'); + +$r = ''; +for $_ (reverse (@array, 1)) { + $r .= $_; +} +is ($r, '1CBA', 'Reverse for array and value with explicit $_'); +$r = ''; +for $_ (reverse (map {$_} @array, 1)) { + $r .= $_; +} +is ($r, '1CBA', 'Reverse for array and value via map with explicit $_'); + + +$r = ''; +for my $i (reverse 1, @array) { + $r .= $i; +} +is ($r, 'CBA1', 'Reverse for value and array with var'); +$r = ''; +for my $i (reverse map {$_} 1, @array) { + $r .= $i; +} +is ($r, 'CBA1', 'Reverse for value and array via map with var'); + +$r = ''; +for my $i (reverse (@array, 1)) { + $r .= $i; +} +is ($r, '1CBA', 'Reverse for array and value with var'); +$r = ''; +for my $i (reverse (map {$_} @array, 1)) { + $r .= $i; +} +is ($r, '1CBA', 'Reverse for array and value via map with var'); diff --git a/gnu/usr.bin/perl/t/comp/use.t b/gnu/usr.bin/perl/t/comp/use.t index 8e9eb8b1a80..0bb8b65b36a 100644 --- a/gnu/usr.bin/perl/t/comp/use.t +++ b/gnu/usr.bin/perl/t/comp/use.t @@ -22,7 +22,7 @@ if ($@) { } print "ok ",$i++,"\n"; -eval sprintf "use %.5f;", $]; +eval sprintf "use %.6f;", $]; if ($@) { print STDERR $@,"\n"; print "not "; @@ -30,20 +30,20 @@ if ($@) { print "ok ",$i++,"\n"; -eval sprintf "use %.5f;", $] - 0.000001; +eval sprintf "use %.6f;", $] - 0.000001; if ($@) { print STDERR $@,"\n"; print "not "; } print "ok ",$i++,"\n"; -eval sprintf("use %.5f;", $] + 1); +eval sprintf("use %.6f;", $] + 1); unless ($@) { print "not "; } print "ok ",$i++,"\n"; -eval sprintf "use %.5f;", $] + 0.00001; +eval sprintf "use %.6f;", $] + 0.00001; unless ($@) { print "not "; } diff --git a/gnu/usr.bin/perl/t/harness b/gnu/usr.bin/perl/t/harness index f7239fe3b17..e745db8a34d 100644 --- a/gnu/usr.bin/perl/t/harness +++ b/gnu/usr.bin/perl/t/harness @@ -47,6 +47,9 @@ foreach (keys %datahandle) { my @tests = (); +# [.VMS]TEST.COM calls harness with empty arguments, so clean-up @ARGV +@ARGV = grep $_ && length( $_ ) => @ARGV; + if (@ARGV) { if ($^O eq 'MSWin32') { @tests = map(glob($_),@ARGV); diff --git a/gnu/usr.bin/perl/t/io/open.t b/gnu/usr.bin/perl/t/io/open.t index 5e1b5ec80d4..e12b4475d1a 100644 --- a/gnu/usr.bin/perl/t/io/open.t +++ b/gnu/usr.bin/perl/t/io/open.t @@ -12,7 +12,7 @@ use Config; $Is_VMS = $^O eq 'VMS'; $Is_MacOS = $^O eq 'MacOS'; -plan tests => 107; +plan tests => 108; my $Perl = which_perl(); @@ -315,3 +315,9 @@ fresh_perl_is( 'sub f { open(my $fh, "xxx"); $fh = "f"; } f; f;print "ok"', 'ok', { stderr => 1 }, '#29102: Crash on assignment to lexical filehandle'); + +# [perl #31767] Using $1 as a filehandle via open $1, "file" doesn't raise +# an exception + +eval { open $99, "foo" }; +like($@, qr/Modification of a read-only value attempted/, "readonly fh"); diff --git a/gnu/usr.bin/perl/t/op/delete.t b/gnu/usr.bin/perl/t/op/delete.t index 53212a11407..ac4405c4193 100644 --- a/gnu/usr.bin/perl/t/op/delete.t +++ b/gnu/usr.bin/perl/t/op/delete.t @@ -1,6 +1,6 @@ #!./perl -print "1..37\n"; +print "1..38\n"; # delete() on hash elements @@ -129,3 +129,16 @@ print @{$refary[0]} == 1 ? "ok 35\n" : "not ok 35 @list\n"; print "not " if defined $y; print "ok 37\n"; } + +{ + # [perl #30733] array delete didn't free returned element + my $x = 0; + sub X::DESTROY { $x++ } + { + my @a; + $a[0] = bless [], 'X'; + my $y = delete $a[0]; + } + print "not " unless $x == 1; + print "ok 38\n"; +} diff --git a/gnu/usr.bin/perl/t/op/goto.t b/gnu/usr.bin/perl/t/op/goto.t index 859d5a66ee3..3b921238f21 100644 --- a/gnu/usr.bin/perl/t/op/goto.t +++ b/gnu/usr.bin/perl/t/op/goto.t @@ -7,10 +7,12 @@ BEGIN { @INC = qw(. ../lib); } -print "1..33\n"; +print "1..47\n"; require "test.pl"; +$purpose; # update per test, and include in print ok's ! + while ($?) { $foo = 1; label1: @@ -64,7 +66,9 @@ FINALE: print "ok 13\n"; # does goto LABEL handle block contexts correctly? - +$purpose = 'handles block contexts correctly (does scope-hopping)'; +# note that this scope-hopping differs from last & next, +# which always go up-scope strictly. my $cond = 1; for (1) { if ($cond == 1) { @@ -74,12 +78,12 @@ for (1) { elsif ($cond == 0) { OTHER: $cond = 2; - print "ok 14\n"; + print "ok 14 - $purpose\n"; goto THIRD; } else { THIRD: - print "ok 15\n"; + print "ok 15 - $purpose\n"; } } print "ok 16\n"; @@ -87,56 +91,58 @@ print "ok 16\n"; # Does goto work correctly within a for(;;) loop? # (BUG ID 20010309.004) +$purpose = 'goto inside a for(;;) loop body from inside the body'; for(my $i=0;!$i++;) { my $x=1; goto label; - label: print (defined $x?"ok ": "not ok ", "17\n") + label: print (defined $x?"ok ": "not ok ", "17 - $purpose\n") } # Does goto work correctly going *to* a for(;;) loop? # (make sure it doesn't skip the initializer) +$purpose = 'goto a for(;;) loop, from outside (does initializer)'; my ($z, $y) = (0); -FORL1: for($y="ok 18\n"; $z;) {print $y; goto TEST19} -($y,$z) = ("not ok 18\n", 1); +FORL1: for($y="ok 18 - $purpose\n"; $z;) {print $y; goto TEST19} +($y,$z) = ("not ok 18 - $purpose\n", 1); goto FORL1; # Even from within the loop? - TEST19: $z = 0; -FORL2: for($y="ok 19\n"; 1;) { +$purpose = 'goto a for(;;) loop, from inside (does initializer)'; +FORL2: for($y="ok 19 - $purpose\n"; 1;) { if ($z) { print $y; last; } - ($y, $z) = ("not ok 19\n", 1); + ($y, $z) = ("not ok 19 - $purpose\n", 1); goto FORL2; } # Does goto work correctly within a try block? # (BUG ID 20000313.004) - +$purpose = 'works correctly within a try block'; my $ok = 0; eval { my $variable = 1; goto LABEL20; LABEL20: $ok = 1 if $variable; }; -print ($ok&&!$@ ? "ok 20\n" : "not ok 20\n"); +print ($ok&&!$@ ? "ok 20" : "not ok 20", " - $purpose\n"); # And within an eval-string? - - +$purpose = 'works correctly within an eval string'; $ok = 0; eval q{ my $variable = 1; goto LABEL21; LABEL21: $ok = 1 if $variable; }; -print ($ok&&!$@ ? "ok 21\n" : "not ok 21\n"); +print ($ok&&!$@ ? "ok" : "not ok", " 21 - $purpose\n"); # Test that goto works in nested eval-string +$purpose = 'works correctly in a nested eval string'; $ok = 0; {eval q{ eval q{ @@ -149,7 +155,7 @@ $ok = 0; }; $ok = 0 if $@; } -print ($ok ? "ok 22\n" : "not ok 22\n"); +print ($ok ? "ok" : "not ok", " 22 - $purpose\n"); { my $false = 0; @@ -241,19 +247,21 @@ my $r = runperl( print "not " if $r ne "ok\n"; print "ok 33 - avoid pad without an \@_\n"; - +goto moretests; exit; bypass: -print "ok 5\n"; +$purpose = 'eval "goto $x"'; +print "ok 5 - $purpose\n"; # Test autoloading mechanism. sub two { ($pack, $file, $line) = caller; # Should indicate original call stats. + $purpose = 'autoloading mechanism.'; print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE" - ? "ok 7\n" - : "not ok 7\n"; + ? "ok 7 - $purpose\n" + : "not ok 7 - $purpose\n"; } sub one { @@ -267,9 +275,11 @@ $FILE = __FILE__; $LINE = __LINE__ + 1; &one(1,2,3); +$purpose = 'goto NOWHERE sets $@'; $wherever = NOWHERE; eval { goto $wherever }; -print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n"; +print $@ =~ /Can't find label NOWHERE/ + ? "ok 8 - $purpose\n" : "not ok 8 - $purpose\n"; #' # see if a modified @_ propagates { @@ -290,3 +300,119 @@ auto("ok 12\n"); $wherever = FINALE; goto $wherever; + +moretests: +# test goto duplicated labels. +{ + my $z = 0; + $purpose = "catch goto middle of foreach"; + eval { + $z = 0; + for (0..1) { + L4: # not outer scope + $z += 10; + last; + } + goto L4 if $z == 10; + last; + }; + print ($@ =~ /Can't "goto" into the middle of a foreach loop/ #' + ? "ok" : "not ok", " 34 - $purpose\n"); + + $z = 0; + # ambiguous label resolution (outer scope means endless loop!) + $purpose = "prefer same scope (loop body) to outer scope (loop entry)"; + L1: + for my $x (0..1) { + $z += 10; + print $z == 10 ? "" : "not ", "ok 35 - $purpose\n"; + goto L1 unless $x; + $z += 10; + L1: + print $z == 10 ? "" : "not ", "ok 36 - $purpose\n"; + last; + } + + $purpose = "prefer this scope (block body) to outer scope (block entry)"; + $z = 0; + L2: + { + $z += 10; + print $z == 10 ? "" : "not ", "ok 37 - $purpose\n"; + goto L2 if $z == 10; + $z += 10; + L2: + print $z == 10 ? "" : "not ", "ok 38 - $purpose\n"; + } + + + { + $purpose = "prefer this scope to inner scope"; + $z = 0; + while (1) { + L3: # not inner scope + $z += 10; + last; + } + print $z == 10 ? "": "not ", "ok 39 - $purpose\n"; + goto L3 if $z == 10; + $z += 10; + L3: # this scope ! + print $z == 10 ? "" : "not ", "ok 40 - $purpose\n"; + } + + L4: # not outer scope + { + $purpose = "prefer this scope to inner,outer scopes"; + $z = 0; + while (1) { + L4: # not inner scope + $z += 1; + last; + } + print $z == 1 ? "": "not ", "ok 41 - $purpose\n"; + goto L4 if $z == 1; + $z += 10; + L4: # this scope ! + print $z == 1 ? "": "not ", "ok 42 - $purpose\n"; + } + + { + $purpose = "same label, multiple times in same scope (choose 1st)"; + my $tnum = 43; + my $loop; + for $x (0..1) { + L2: # without this, fails 1 (middle) out of 3 iterations + $z = 0; + L2: + $z += 10; + print $z == 10 ? "": "not ", "ok $tnum - $purpose\n"; + $tnum++; + goto L2 if $z == 10 and not $loop++; + } + } +} + +# deep recursion with gotos eventually caused a stack reallocation +# which messed up buggy internals that didn't expect the stack to move + +sub recurse1 { + unshift @_, "x"; + goto &recurse2; +} +sub recurse2 { + $x = shift; + $_[0] ? +1 + recurse1($_[0] - 1) : 0 +} +print "not " unless recurse1(500) == 500; +print "ok 46 - recursive goto &foo\n"; + +# [perl #32039] Chained goto &sub drops data too early. + +sub a32039 { @_=("foo"); goto &b32039; } +sub b32039 { goto &c32039; } +sub c32039 { print $_[0] eq 'foo' ? "" : "not ", "ok 47 - chained &goto\n" } +a32039(); + + + diff --git a/gnu/usr.bin/perl/t/op/list.t b/gnu/usr.bin/perl/t/op/list.t index 4d7a2d5444b..89ccf02c10a 100644 --- a/gnu/usr.bin/perl/t/op/list.t +++ b/gnu/usr.bin/perl/t/op/list.t @@ -1,6 +1,6 @@ #!./perl -print "1..28\n"; +print "1..30\n"; @foo = (1, 2, 3, 4); if ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";} @@ -86,4 +86,13 @@ for ($x = 0; $x < 3; $x++) { my @c = (0, undef, undef, 3)[1, 2]; print "not " unless @b == @c and @c == 2; print "ok 28\n"; + + @b = (29, scalar @c[()]); + print "not " if join(':',@b) ne '29:'; + print "ok 29\n"; + + my %h = (a => 1); + @b = (30, scalar @h{()}); + print "not " if join(':',@b) ne '30:'; + print "ok 30\n"; } diff --git a/gnu/usr.bin/perl/t/op/ref.t b/gnu/usr.bin/perl/t/op/ref.t index 597e03698c9..a59af93d997 100644 --- a/gnu/usr.bin/perl/t/op/ref.t +++ b/gnu/usr.bin/perl/t/op/ref.t @@ -5,7 +5,7 @@ BEGIN { @INC = qw(. ../lib); } -print "1..69\n"; +print "1..70\n"; require 'test.pl'; @@ -368,6 +368,18 @@ print "not " if length $result; print "ok ",++$test," - freeing self-referential typeglob\n"; print "# got: $result\n" if length $result; +# using a regex in the destructor for STDOUT segfaulted because the +# REGEX pad had already been freed (ithreads build only). The +# object is required to trigger the early freeing of GV refs to to STDOUT + +$result = runperl( + prog => '$x=bless[]; sub IO::Handle::DESTROY{$_="bad";s/bad/ok/;print}', + stderr => 1 +); +print "not " unless $result =~ /^(ok)+$/; +print "ok ",++$test," - STDOUT destructor\n"; +print "# got: $result\n" unless $result =~ /^(ok)+$/; + # test global destruction ++$test; @@ -386,3 +398,4 @@ package FINALE; DESTROY { print $_[0][0]; } + diff --git a/gnu/usr.bin/perl/t/op/sleep.t b/gnu/usr.bin/perl/t/op/sleep.t index 5f6c4c0bbbe..c2684ad37c0 100644 --- a/gnu/usr.bin/perl/t/op/sleep.t +++ b/gnu/usr.bin/perl/t/op/sleep.t @@ -1,8 +1,15 @@ #!./perl -# $RCSfile: sleep.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:23 $ +use strict; +use warnings; +use Test::More tests=>4; -print "1..1\n"; +my $start = time; +my $sleep_says = sleep 3; +my $diff = time - $start; -$x = sleep 3; -if ($x >= 2 && $x <= 10) {print "ok 1\n";} else {print "not ok 1 $x\n";} +cmp_ok( $sleep_says, '>=', 2, 'Sleep says it slept at least 2 seconds' ); +cmp_ok( $sleep_says, '<=', 10, '... and no more than 10' ); + +cmp_ok( $diff, '>=', 2, 'Actual time diff is at least 2 seconds' ); +cmp_ok( $diff, '<=', 10, '... and no more than 10' ); diff --git a/gnu/usr.bin/perl/t/op/sort.t b/gnu/usr.bin/perl/t/op/sort.t index c1129c2422f..bdb48856b94 100644 --- a/gnu/usr.bin/perl/t/op/sort.t +++ b/gnu/usr.bin/perl/t/op/sort.t @@ -5,7 +5,7 @@ BEGIN { @INC = '../lib'; } use warnings; -print "1..75\n"; +print "1..129\n"; # these shouldn't hang { @@ -22,7 +22,7 @@ sub Backwards_stacked($$) { my($a,$b) = @_; $a lt $b ? 1 : $a gt $b ? -1 : 0 } my $upperfirst = 'A' lt 'a'; # Beware: in future this may become hairier because of possible -# collation complications: qw(A a B c) can be sorted at least as +# collation complications: qw(A a B b) can be sorted at least as # any of the following # # A a B b @@ -391,6 +391,282 @@ sub ok { ok "@a", "c b a x", "un-inplace sort with function of lexical 2"; } +# Test optimisations of reversed sorts. As we now guarantee stability by +# default, # optimisations which do not provide this are bogus. +{ + package Oscalar; + use overload (qw("" stringify 0+ numify fallback 1)); + + sub new { + bless [$_[1], $_[2]], $_[0]; + } + + sub stringify { $_[0]->[0] } + + sub numify { $_[0]->[1] } +} + +sub generate { + my $count = 0; + map {new Oscalar $_, $count++} qw(A A A B B B C C C); +} + +my @input = &generate; +my @output = sort @input; +ok join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", "Simple stable sort"; + +@input = &generate; +@input = sort @input; +ok join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8", + "Simple stable in place sort"; + +# This won't be very interesting +@input = &generate; +@output = sort {$a <=> $b} @input; +ok "@output", "A A A B B B C C C", 'stable $a <=> $b sort'; + +@input = &generate; +@output = sort {$a cmp $b} @input; +ok join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", 'stable $a cmp $b sort'; + +@input = &generate; +@input = sort {$a cmp $b} @input; +ok join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8", + 'stable $a cmp $b in place sort'; + +@input = &generate; +@output = sort {$b cmp $a} @input; +ok join(" ", map {0+$_} @output), "6 7 8 3 4 5 0 1 2", 'stable $b cmp $a sort'; + +@input = &generate; +@input = sort {$b cmp $a} @input; +ok join(" ", map {0+$_} @input), "6 7 8 3 4 5 0 1 2", + 'stable $b cmp $a in place sort'; + +@input = &generate; +@output = reverse sort @input; +ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0", "Reversed stable sort"; + +@input = &generate; +@input = reverse sort @input; +ok join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0", + "Reversed stable in place sort"; + +@input = &generate; +my $output = reverse sort @input; +ok $output, "CCCBBBAAA", "Reversed stable sort in scalar context"; + + +@input = &generate; +@output = reverse sort {$a cmp $b} @input; +ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0", + 'reversed stable $a cmp $b sort'; + +@input = &generate; +@input = reverse sort {$a cmp $b} @input; +ok join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0", + 'revesed stable $a cmp $b in place sort'; + +@input = &generate; +$output = reverse sort {$a cmp $b} @input; +ok $output, "CCCBBBAAA", 'Reversed stable $a cmp $b sort in scalar context'; + +@input = &generate; +@output = reverse sort {$b cmp $a} @input; +ok join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6", + 'reversed stable $b cmp $a sort'; + +@input = &generate; +@input = reverse sort {$b cmp $a} @input; +ok join(" ", map {0+$_} @input), "2 1 0 5 4 3 8 7 6", + 'revesed stable $b cmp $a in place sort'; + +@input = &generate; +$output = reverse sort {$b cmp $a} @input; +ok $output, "AAABBBCCC", 'Reversed stable $b cmp $a sort in scalar context'; + +sub stuff { + # Something complex enough to defeat any constant folding optimiser + $$ - $$; +} + +@input = &generate; +@output = reverse sort {stuff || $a cmp $b} @input; +ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0", + 'reversed stable complex sort'; + +@input = &generate; +@input = reverse sort {stuff || $a cmp $b} @input; +ok join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0", + 'revesed stable complex in place sort'; + +@input = &generate; +$output = reverse sort {stuff || $a cmp $b } @input; +ok $output, "CCCBBBAAA", 'Reversed stable complex sort in scalar context'; + +sub sortr { + reverse sort @_; +} + +@output = sortr &generate; +ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0", + 'reversed stable sort return list context'; +$output = sortr &generate; +ok $output, "CCCBBBAAA", + 'reversed stable sort return scalar context'; + +sub sortcmpr { + reverse sort {$a cmp $b} @_; +} + +@output = sortcmpr &generate; +ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0", + 'reversed stable $a cmp $b sort return list context'; +$output = sortcmpr &generate; +ok $output, "CCCBBBAAA", + 'reversed stable $a cmp $b sort return scalar context'; + +sub sortcmprba { + reverse sort {$b cmp $a} @_; +} + +@output = sortcmprba &generate; +ok join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6", + 'reversed stable $b cmp $a sort return list context'; +$output = sortcmprba &generate; +ok $output, "AAABBBCCC", +'reversed stable $b cmp $a sort return scalar context'; + +sub sortcmprq { + reverse sort {stuff || $a cmp $b} @_; +} + +@output = sortcmpr &generate; +ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0", + 'reversed stable complex sort return list context'; +$output = sortcmpr &generate; +ok $output, "CCCBBBAAA", + 'reversed stable complex sort return scalar context'; + +# And now with numbers + +sub generate1 { + my $count = 'A'; + map {new Oscalar $count++, $_} 0, 0, 0, 1, 1, 1, 2, 2, 2; +} + +# This won't be very interesting +@input = &generate1; +@output = sort {$a cmp $b} @input; +ok "@output", "A B C D E F G H I", 'stable $a cmp $b sort'; + +@input = &generate1; +@output = sort {$a <=> $b} @input; +ok "@output", "A B C D E F G H I", 'stable $a <=> $b sort'; + +@input = &generate1; +@input = sort {$a <=> $b} @input; +ok "@input", "A B C D E F G H I", 'stable $a <=> $b in place sort'; + +@input = &generate1; +@output = sort {$b <=> $a} @input; +ok "@output", "G H I D E F A B C", 'stable $b <=> $a sort'; + +@input = &generate1; +@input = sort {$b <=> $a} @input; +ok "@input", "G H I D E F A B C", 'stable $b <=> $a in place sort'; + +# test that optimized {$b cmp $a} and {$b <=> $a} remain stable +# (new in 5.9) without overloading +{ no warnings; +@b = sort { $b <=> $a } @input = qw/5first 6first 5second 6second/; +ok "@b" , "6first 6second 5first 5second", "optimized {$b <=> $a} without overloading" ; +@input = sort {$b <=> $a} @input; +ok "@input" , "6first 6second 5first 5second","inline optimized {$b <=> $a} without overloading" ; +}; + +# These two are actually doing string cmp on 0 1 and 2 +@input = &generate1; +@output = reverse sort @input; +ok "@output", "I H G F E D C B A", "Reversed stable sort"; + +@input = &generate1; +@input = reverse sort @input; +ok "@input", "I H G F E D C B A", "Reversed stable in place sort"; + +@input = &generate1; +$output = reverse sort @input; +ok $output, "IHGFEDCBA", "Reversed stable sort in scalar context"; + +@input = &generate1; +@output = reverse sort {$a <=> $b} @input; +ok "@output", "I H G F E D C B A", 'reversed stable $a <=> $b sort'; + +@input = &generate1; +@input = reverse sort {$a <=> $b} @input; +ok "@input", "I H G F E D C B A", 'revesed stable $a <=> $b in place sort'; + +@input = &generate1; +$output = reverse sort {$a <=> $b} @input; +ok $output, "IHGFEDCBA", 'reversed stable $a <=> $b sort in scalar context'; + +@input = &generate1; +@output = reverse sort {$b <=> $a} @input; +ok "@output", "C B A F E D I H G", 'reversed stable $b <=> $a sort'; + +@input = &generate1; +@input = reverse sort {$b <=> $a} @input; +ok "@input", "C B A F E D I H G", 'revesed stable $b <=> $a in place sort'; + +@input = &generate1; +$output = reverse sort {$b <=> $a} @input; +ok $output, "CBAFEDIHG", 'reversed stable $b <=> $a sort in scalar context'; + +@input = &generate1; +@output = reverse sort {stuff || $a <=> $b} @input; +ok "@output", "I H G F E D C B A", 'reversed stable complex sort'; + +@input = &generate1; +@input = reverse sort {stuff || $a <=> $b} @input; +ok "@input", "I H G F E D C B A", 'revesed stable complex in place sort'; + +@input = &generate1; +$output = reverse sort {stuff || $a <=> $b} @input; +ok $output, "IHGFEDCBA", 'reversed stable complex sort in scalar context'; + +sub sortnumr { + reverse sort {$a <=> $b} @_; +} + +@output = sortnumr &generate1; +ok "@output", "I H G F E D C B A", + 'reversed stable $a <=> $b sort return list context'; +$output = sortnumr &generate1; +ok $output, "IHGFEDCBA", 'reversed stable $a <=> $b sort return scalar context'; + +sub sortnumrba { + reverse sort {$b <=> $a} @_; +} + +@output = sortnumrba &generate1; +ok "@output", "C B A F E D I H G", + 'reversed stable $b <=> $a sort return list context'; +$output = sortnumrba &generate1; +ok $output, "CBAFEDIHG", 'reversed stable $b <=> $a sort return scalar context'; + +sub sortnumrq { + reverse sort {stuff || $a <=> $b} @_; +} + +@output = sortnumrq &generate1; +ok "@output", "I H G F E D C B A", + 'reversed stable complex sort return list context'; +$output = sortnumrq &generate1; +ok $output, "IHGFEDCBA", 'reversed stable complex sort return scalar context'; +@output = reverse (sort(qw(C A B)), 0); +ok "@output", "0 C B A", 'reversed sort with trailing argument'; +@output = reverse (0, sort(qw(C A B))); +ok "@output", "C B A 0", 'reversed sort with leading argument'; diff --git a/gnu/usr.bin/perl/t/op/taint.t b/gnu/usr.bin/perl/t/op/taint.t index f37f3aaae3a..ce436eeb66a 100644 --- a/gnu/usr.bin/perl/t/op/taint.t +++ b/gnu/usr.bin/perl/t/op/taint.t @@ -16,6 +16,7 @@ use strict; use Config; use File::Spec::Functions; +my $total_tests = 236; my $test = 177; sub ok ($;$) { my($ok, $name) = @_; @@ -124,7 +125,7 @@ my $echo = "$Invoke_Perl $ECHO"; my $TEST = catfile(curdir(), 'TEST'); -print "1..223\n"; +print "1..$total_tests\n"; # First, let's make sure that Perl is checking the dangerous # environment variables. Maybe they aren't set yet, so we'll @@ -1041,3 +1042,39 @@ else eval '$^O = $^X'; test 223, $@ =~ /Insecure dependency in/; } + +EFFECTIVELY_CONSTANTS: { + my $tainted_number = 12 + $TAINT0; + test 224, tainted( $tainted_number ); + + # Even though it's always 0, it's still tainted + my $tainted_product = $tainted_number * 0; + test 225, tainted( $tainted_product ); + test 226, $tainted_product == 0; +} + +TERNARY_CONDITIONALS: { + my $tainted_true = $TAINT . "blah blah blah"; + my $tainted_false = $TAINT0; + test 227, tainted( $tainted_true ); + test 228, tainted( $tainted_false ); + + my $result = $tainted_true ? "True" : "False"; + test 229, $result eq "True"; + test 230, !tainted( $result ); + + $result = $tainted_false ? "True" : "False"; + test 231, $result eq "False"; + test 232, !tainted( $result ); + + my $untainted_whatever = "The Fabulous Johnny Cash"; + my $tainted_whatever = "Soft Cell" . $TAINT; + + $result = $tainted_true ? $tainted_whatever : $untainted_whatever; + test 233, $result eq "Soft Cell"; + test 234, tainted( $result ); + + $result = $tainted_false ? $tainted_whatever : $untainted_whatever; + test 235, $result eq "The Fabulous Johnny Cash"; + test 236, !tainted( $result ); +} diff --git a/gnu/usr.bin/perl/t/op/tie.t b/gnu/usr.bin/perl/t/op/tie.t index 51c4b3a5b85..bd5d079a60d 100644 --- a/gnu/usr.bin/perl/t/op/tie.t +++ b/gnu/usr.bin/perl/t/op/tie.t @@ -294,7 +294,6 @@ sub FETCH { *a = \1; 1 } tie $a, 'main'; print $a; EXPECT -Tied variable freed while still in use at - line 6. ######## # [20020716.007] - nested FETCHES diff --git a/gnu/usr.bin/perl/taint.c b/gnu/usr.bin/perl/taint.c index 7d4eb41ff29..d3fdeab68ff 100644 --- a/gnu/usr.bin/perl/taint.c +++ b/gnu/usr.bin/perl/taint.c @@ -14,6 +14,9 @@ * liar, Saruman, and a corrupter of men's hearts." --Theoden */ +/* This file contains a few functions for handling data tainting in Perl + */ + #include "EXTERN.h" #define PERL_IN_TAINT_C #include "perl.h" diff --git a/gnu/usr.bin/perl/toke.c b/gnu/usr.bin/perl/toke.c index 8525419b1d8..07f7b8bb2c1 100644 --- a/gnu/usr.bin/perl/toke.c +++ b/gnu/usr.bin/perl/toke.c @@ -2028,19 +2028,17 @@ Perl_filter_del(pTHX_ filter_t funcp) } -/* Invoke the n'th filter function for the current rsfp. */ +/* Invoke the idxth filter function for the current rsfp. */ +/* maxlen 0 = read one text line */ I32 Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) - - - /* 0 = read one text line */ { filter_t funcp; SV *datasv = NULL; if (!PL_rsfp_filters) return -1; - if (idx > AvFILLp(PL_rsfp_filters)){ /* Any more filters? */ + if (idx > AvFILLp(PL_rsfp_filters)) { /* Any more filters? */ /* Provide a default input filter to make life easy. */ /* Note that we append to the line. This is handy. */ DEBUG_P(PerlIO_printf(Perl_debug_log, @@ -2071,7 +2069,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) return SvCUR(buf_sv); } /* Skip this filter slot if filter has been deleted */ - if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef){ + if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef) { DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_read %d: skipped (filter deleted)\n", idx)); @@ -2097,7 +2095,6 @@ S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) } #endif if (PL_rsfp_filters) { - if (!append) SvCUR_set(sv, 0); /* start with empty line */ if (FILTER_READ(0, sv, 0) > 0) @@ -6629,7 +6626,7 @@ S_scan_heredoc(pTHX_ register char *s) sv_setpvn(tmpstr,d+1,s-d); s += len - 1; sv_catpvn(herewas,s,bufend-s); - (void)strcpy(bufptr,SvPVX(herewas)); + Copy(SvPVX(herewas),bufptr,SvCUR(herewas) + 1,char); s = olds; goto retval; @@ -6691,10 +6688,11 @@ S_scan_heredoc(pTHX_ register char *s) av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv); } if (*s == term && memEQ(s,PL_tokenbuf,len)) { - s = PL_bufend - 1; - *s = ' '; + STRLEN off = PL_bufend - 1 - SvPVX(PL_linestr); + *(SvPVX(PL_linestr) + off ) = ' '; sv_catsv(PL_linestr,herewas); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); + s = SvPVX(PL_linestr) + off; /* In case PV of PL_linestr moved. */ } else { s = PL_bufend; @@ -6799,7 +6797,7 @@ S_scan_inputsymbol(pTHX_ char *start) /* turn <> into <ARGV> */ if (!len) - (void)strcpy(d,"ARGV"); + Copy("ARGV",d,5,char); /* Check whether readline() is overriden */ if (((gv_readline = gv_fetchpv("readline", FALSE, SVt_PVCV)) @@ -7254,6 +7252,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) UV u = 0; I32 shift; bool overflowed = FALSE; + bool just_zero = TRUE; /* just plain 0 or binary number? */ static NV nvshift[5] = { 1.0, 2.0, 4.0, 8.0, 16.0 }; static char* bases[5] = { "", "binary", "", "octal", "hexadecimal" }; @@ -7270,9 +7269,11 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) if (s[1] == 'x') { shift = 4; s += 2; + just_zero = FALSE; } else if (s[1] == 'b') { shift = 1; s += 2; + just_zero = FALSE; } /* check for a decimal in disguise */ else if (s[1] == '.' || s[1] == 'e' || s[1] == 'E') @@ -7344,6 +7345,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) */ digit: + just_zero = FALSE; if (!overflowed) { x = u << shift; /* make room for the digit */ @@ -7402,7 +7404,10 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) #endif sv_setuv(sv, u); } - if (PL_hints & HINT_NEW_BINARY) + if (just_zero && (PL_hints & HINT_NEW_INTEGER)) + sv = new_constant(start, s - start, "integer", + sv, Nullsv, NULL); + else if (PL_hints & HINT_NEW_BINARY) sv = new_constant(start, s - start, "binary", sv, Nullsv, NULL); } break; @@ -7862,10 +7867,9 @@ S_swallow_bom(pTHX_ U8 *s) filter_add(utf16rev_textfilter, NULL); New(898, news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8); - PL_bufend = - (char*)utf16_to_utf8_reversed(s, news, - PL_bufend - (char*)s - 1, - &newlen); + utf16_to_utf8_reversed(s, news, + PL_bufend - (char*)s - 1, + &newlen); sv_setpvn(PL_linestr, (const char*)news, newlen); Safefree(news); SvUTF8_on(PL_linestr); @@ -7889,10 +7893,9 @@ S_swallow_bom(pTHX_ U8 *s) filter_add(utf16_textfilter, NULL); New(898, news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8); - PL_bufend = - (char*)utf16_to_utf8(s, news, - PL_bufend - (char*)s, - &newlen); + utf16_to_utf8(s, news, + PL_bufend - (char*)s, + &newlen); sv_setpvn(PL_linestr, (const char*)news, newlen); Safefree(news); SvUTF8_on(PL_linestr); @@ -7959,38 +7962,42 @@ restore_rsfp(pTHX_ void *f) static I32 utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) { + STRLEN old = SvCUR(sv); I32 count = FILTER_READ(idx+1, sv, maxlen); + DEBUG_P(PerlIO_printf(Perl_debug_log, + "utf16_textfilter(%p): %d %d (%d)\n", + utf16_textfilter, idx, maxlen, count)); if (count) { U8* tmps; - U8* tend; I32 newlen; New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8); - if (!*SvPV_nolen(sv)) - /* Game over, but don't feed an odd-length string to utf16_to_utf8 */ - return count; - - tend = utf16_to_utf8((U8*)SvPVX(sv), tmps, SvCUR(sv), &newlen); - sv_usepvn(sv, (char*)tmps, tend - tmps); + Copy(SvPVX(sv), tmps, old, char); + utf16_to_utf8((U8*)SvPVX(sv) + old, tmps + old, + SvCUR(sv) - old, &newlen); + sv_usepvn(sv, (char*)tmps, (STRLEN)newlen + old); } - return count; + DEBUG_P({sv_dump(sv);}); + return SvCUR(sv); } static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen) { + STRLEN old = SvCUR(sv); I32 count = FILTER_READ(idx+1, sv, maxlen); + DEBUG_P(PerlIO_printf(Perl_debug_log, + "utf16rev_textfilter(%p): %d %d (%d)\n", + utf16rev_textfilter, idx, maxlen, count)); if (count) { U8* tmps; - U8* tend; I32 newlen; - if (!*SvPV_nolen(sv)) - /* Game over, but don't feed an odd-length string to utf16_to_utf8 */ - return count; - New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8); - tend = utf16_to_utf8_reversed((U8*)SvPVX(sv), tmps, SvCUR(sv), &newlen); - sv_usepvn(sv, (char*)tmps, tend - tmps); + Copy(SvPVX(sv), tmps, old, char); + utf16_to_utf8((U8*)SvPVX(sv) + old, tmps + old, + SvCUR(sv) - old, &newlen); + sv_usepvn(sv, (char*)tmps, (STRLEN)newlen + old); } + DEBUG_P({ sv_dump(sv); }); return count; } #endif diff --git a/gnu/usr.bin/perl/universal.c b/gnu/usr.bin/perl/universal.c index 4ab796f4e10..10f600b6d5f 100644 --- a/gnu/usr.bin/perl/universal.c +++ b/gnu/usr.bin/perl/universal.c @@ -14,6 +14,10 @@ * beginning." --Gandalf, relating Gollum's story */ +/* This file contains the code that implements the functions in Perl's + * UNIVERSAL package, such as UNIVERSAL->can(). + */ + #include "EXTERN.h" #define PERL_IN_UNIVERSAL_C #include "perl.h" diff --git a/gnu/usr.bin/perl/util.c b/gnu/usr.bin/perl/util.c index 1ca158b0076..0417f7f2b67 100644 --- a/gnu/usr.bin/perl/util.c +++ b/gnu/usr.bin/perl/util.c @@ -13,6 +13,12 @@ * not content." --Gandalf */ +/* This file contains assorted utility routines. + * Which is a polite way of saying any stuff that people couldn't think of + * a better place for. Amongst other things, it includes the warning and + * dieing stuff, plus wrappers for malloc code. + */ + #include "EXTERN.h" #define PERL_IN_UTIL_C #include "perl.h" @@ -751,12 +757,12 @@ be freed with the C<Safefree()> function. char * Perl_savepv(pTHX_ const char *pv) { - register char *newaddr = Nullch; - if (pv) { - New(902,newaddr,strlen(pv)+1,char); - (void)strcpy(newaddr,pv); - } - return newaddr; + register char *newaddr; + if (!pv) + return Nullch; + + New(902,newaddr,strlen(pv)+1,char); + return strcpy(newaddr,pv); } /* same thing but with a known length */ @@ -780,13 +786,13 @@ Perl_savepvn(pTHX_ const char *pv, register I32 len) New(903,newaddr,len+1,char); /* Give a meaning to NULL pointer mainly for the use in sv_magic() */ if (pv) { - Copy(pv,newaddr,len,char); /* might not be null terminated */ - newaddr[len] = '\0'; /* is now */ + /* might not be null terminated */ + newaddr[len] = '\0'; + return CopyD(pv,newaddr,len,char); } else { - Zero(newaddr,len+1,char); + return ZeroD(newaddr,len+1,char); } - return newaddr; } /* @@ -800,12 +806,17 @@ which is shared between threads. char * Perl_savesharedpv(pTHX_ const char *pv) { - register char *newaddr = Nullch; - if (pv) { - newaddr = (char*)PerlMemShared_malloc(strlen(pv)+1); - (void)strcpy(newaddr,pv); + register char *newaddr; + if (!pv) + return Nullch; + + newaddr = (char*)PerlMemShared_malloc(strlen(pv)+1); + if (!newaddr) { + PerlLIO_write(PerlIO_fileno(Perl_error_log), + PL_no_mem, strlen(PL_no_mem)); + my_exit(1); } - return newaddr; + return strcpy(newaddr,pv); } @@ -1030,74 +1041,94 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen) } } -OP * -Perl_vdie(pTHX_ const char* pat, va_list *args) +/* Common code used by vcroak, vdie and vwarner */ + +void S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8); + +char * +S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen, + I32* utf8) { char *message; - int was_in_eval = PL_in_eval; - HV *stash; - GV *gv; - CV *cv; - SV *msv; - STRLEN msglen; - I32 utf8 = 0; - - DEBUG_S(PerlIO_printf(Perl_debug_log, - "%p: die: curstack = %p, mainstack = %p\n", - thr, PL_curstack, PL_mainstack)); if (pat) { - msv = vmess(pat, args); + SV *msv = vmess(pat, args); if (PL_errors && SvCUR(PL_errors)) { sv_catsv(PL_errors, msv); - message = SvPV(PL_errors, msglen); + message = SvPV(PL_errors, *msglen); SvCUR_set(PL_errors, 0); } else - message = SvPV(msv,msglen); - utf8 = SvUTF8(msv); + message = SvPV(msv,*msglen); + *utf8 = SvUTF8(msv); } else { message = Nullch; - msglen = 0; } DEBUG_S(PerlIO_printf(Perl_debug_log, - "%p: die: message = %s\ndiehook = %p\n", + "%p: die/croak: message = %s\ndiehook = %p\n", thr, message, PL_diehook)); if (PL_diehook) { - /* sv_2cv might call Perl_croak() */ - SV *olddiehook = PL_diehook; - ENTER; - SAVESPTR(PL_diehook); - PL_diehook = Nullsv; - cv = sv_2cv(olddiehook, &stash, &gv, 0); - LEAVE; - if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) { - dSP; - SV *msg; + S_vdie_common(aTHX_ message, *msglen, *utf8); + } + return message; +} - ENTER; - save_re_context(); - if (message) { - msg = newSVpvn(message, msglen); - SvFLAGS(msg) |= utf8; - SvREADONLY_on(msg); - SAVEFREESV(msg); - } - else { - msg = ERRSV; - } +void +S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8) +{ + HV *stash; + GV *gv; + CV *cv; + /* sv_2cv might call Perl_croak() */ + SV *olddiehook = PL_diehook; + + assert(PL_diehook); + ENTER; + SAVESPTR(PL_diehook); + PL_diehook = Nullsv; + cv = sv_2cv(olddiehook, &stash, &gv, 0); + LEAVE; + if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) { + dSP; + SV *msg; - PUSHSTACKi(PERLSI_DIEHOOK); - PUSHMARK(SP); - XPUSHs(msg); - PUTBACK; - call_sv((SV*)cv, G_DISCARD); - POPSTACK; - LEAVE; + ENTER; + save_re_context(); + if (message) { + msg = newSVpvn(message, msglen); + SvFLAGS(msg) |= utf8; + SvREADONLY_on(msg); + SAVEFREESV(msg); + } + else { + msg = ERRSV; } + + PUSHSTACKi(PERLSI_DIEHOOK); + PUSHMARK(SP); + XPUSHs(msg); + PUTBACK; + call_sv((SV*)cv, G_DISCARD); + POPSTACK; + LEAVE; } +} + +OP * +Perl_vdie(pTHX_ const char* pat, va_list *args) +{ + char *message; + int was_in_eval = PL_in_eval; + STRLEN msglen; + I32 utf8 = 0; + + DEBUG_S(PerlIO_printf(Perl_debug_log, + "%p: die: curstack = %p, mainstack = %p\n", + thr, PL_curstack, PL_mainstack)); + + message = S_vdie_croak_common(aTHX_ pat, args, &msglen, &utf8); PL_restartop = die_where(message, msglen); SvFLAGS(ERRSV) |= utf8; @@ -1138,65 +1169,11 @@ void Perl_vcroak(pTHX_ const char* pat, va_list *args) { char *message; - HV *stash; - GV *gv; - CV *cv; - SV *msv; STRLEN msglen; I32 utf8 = 0; - if (pat) { - msv = vmess(pat, args); - if (PL_errors && SvCUR(PL_errors)) { - sv_catsv(PL_errors, msv); - message = SvPV(PL_errors, msglen); - SvCUR_set(PL_errors, 0); - } - else - message = SvPV(msv,msglen); - utf8 = SvUTF8(msv); - } - else { - message = Nullch; - msglen = 0; - } - - DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%"UVxf" %s", - PTR2UV(thr), message)); - - if (PL_diehook) { - /* sv_2cv might call Perl_croak() */ - SV *olddiehook = PL_diehook; - ENTER; - SAVESPTR(PL_diehook); - PL_diehook = Nullsv; - cv = sv_2cv(olddiehook, &stash, &gv, 0); - LEAVE; - if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) { - dSP; - SV *msg; + message = S_vdie_croak_common(aTHX_ pat, args, &msglen, &utf8); - ENTER; - save_re_context(); - if (message) { - msg = newSVpvn(message, msglen); - SvFLAGS(msg) |= utf8; - SvREADONLY_on(msg); - SAVEFREESV(msg); - } - else { - msg = ERRSV; - } - - PUSHSTACKi(PERLSI_DIEHOOK); - PUSHMARK(SP); - XPUSHs(msg); - PUTBACK; - call_sv((SV*)cv, G_DISCARD); - POPSTACK; - LEAVE; - } - } if (PL_in_eval) { PL_restartop = die_where(message, msglen); SvFLAGS(ERRSV) |= utf8; @@ -1354,49 +1331,18 @@ Perl_warner(pTHX_ U32 err, const char* pat,...) void Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) { - char *message; - HV *stash; - GV *gv; - CV *cv; - SV *msv; - STRLEN msglen; - I32 utf8 = 0; - - msv = vmess(pat, args); - message = SvPV(msv, msglen); - utf8 = SvUTF8(msv); - if (ckDEAD(err)) { + SV *msv = vmess(pat, args); + STRLEN msglen; + char *message = SvPV(msv, msglen); + I32 utf8 = SvUTF8(msv); + #ifdef USE_5005THREADS DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%"UVxf" %s", PTR2UV(thr), message)); #endif /* USE_5005THREADS */ if (PL_diehook) { - /* sv_2cv might call Perl_croak() */ - SV *olddiehook = PL_diehook; - ENTER; - SAVESPTR(PL_diehook); - PL_diehook = Nullsv; - cv = sv_2cv(olddiehook, &stash, &gv, 0); - LEAVE; - if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) { - dSP; - SV *msg; - - ENTER; - save_re_context(); - msg = newSVpvn(message, msglen); - SvFLAGS(msg) |= utf8; - SvREADONLY_on(msg); - SAVEFREESV(msg); - - PUSHSTACKi(PERLSI_DIEHOOK); - PUSHMARK(sp); - XPUSHs(msg); - PUTBACK; - call_sv((SV*)cv, G_DISCARD); - POPSTACK; - LEAVE; - } + assert(message); + S_vdie_common(aTHX_ message, msglen, utf8); } if (PL_in_eval) { PL_restartop = die_where(message, msglen); @@ -1407,36 +1353,7 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) my_failure_exit(); } else { - if (PL_warnhook) { - /* sv_2cv might call Perl_warn() */ - SV *oldwarnhook = PL_warnhook; - ENTER; - SAVESPTR(PL_warnhook); - PL_warnhook = Nullsv; - cv = sv_2cv(oldwarnhook, &stash, &gv, 0); - LEAVE; - if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) { - dSP; - SV *msg; - - ENTER; - save_re_context(); - msg = newSVpvn(message, msglen); - SvFLAGS(msg) |= utf8; - SvREADONLY_on(msg); - SAVEFREESV(msg); - - PUSHSTACKi(PERLSI_WARNHOOK); - PUSHMARK(sp); - XPUSHs(msg); - PUTBACK; - call_sv((SV*)cv, G_DISCARD); - POPSTACK; - LEAVE; - return; - } - } - write_to_stderr(message, msglen); + Perl_vwarn(aTHX_ pat, args); } } @@ -1462,6 +1379,7 @@ Perl_my_setenv(pTHX_ char *nam, char *val) #endif { #ifndef PERL_USE_SAFE_PUTENV + if (!PL_use_safe_putenv) { /* most putenv()s leak, so we manipulate environ directly */ register I32 i=setenv_getix(nam); /* where does it go? */ int nlen, vlen; @@ -1502,8 +1420,8 @@ Perl_my_setenv(pTHX_ char *nam, char *val) environ[i] = (char*)safesysmalloc((nlen+vlen+2) * sizeof(char)); /* all that work just for this */ my_setenv_format(environ[i], nam, nlen, val, vlen); - -#else /* PERL_USE_SAFE_PUTENV */ + } else { +# endif # if defined(__CYGWIN__) || defined( EPOC) setenv(nam, val, 1); # else @@ -1518,7 +1436,9 @@ Perl_my_setenv(pTHX_ char *nam, char *val) my_setenv_format(new_env, nam, nlen, val, vlen); (void)putenv(new_env); # endif /* __CYGWIN__ */ -#endif /* PERL_USE_SAFE_PUTENV */ +#ifndef PERL_USE_SAFE_PUTENV + } +#endif } } diff --git a/gnu/usr.bin/perl/utils/c2ph.PL b/gnu/usr.bin/perl/utils/c2ph.PL index 9334aa10436..53a20732237 100644 --- a/gnu/usr.bin/perl/utils/c2ph.PL +++ b/gnu/usr.bin/perl/utils/c2ph.PL @@ -278,7 +278,7 @@ Anyway, here it is. Should run on perl v4 or greater. Maybe less. =cut -$RCSID = '$Id: c2ph.PL,v 1.7 2003/12/03 03:02:50 millert Exp $'; +$RCSID = '$Id: c2ph.PL,v 1.8 2004/08/09 18:10:32 millert Exp $'; use File::Temp; @@ -468,7 +468,7 @@ EOF $CC $CFLAGS $DEFINES and the resulting *.s groped for stab information. If no files are supplied, then stdin is read directly with the assumption that it - contains stab information. All other liens will be ignored. At + contains stab information. All other lines will be ignored. At most one *.s file should be supplied. EOF diff --git a/gnu/usr.bin/perl/vms/ext/filespec.t b/gnu/usr.bin/perl/vms/ext/filespec.t index 559659f2afe..b0efa4c7e62 100644 --- a/gnu/usr.bin/perl/vms/ext/filespec.t +++ b/gnu/usr.bin/perl/vms/ext/filespec.t @@ -127,5 +127,5 @@ __path_ vmspath [.__path_] ./../. vmsify [-] # Our override of File::Spec->canonpath can do some strange things -__dev:[__dir.000000]__foo File::Spec->canonpath __dev:[__dir]__foo +__dev:[__dir.000000]__foo File::Spec->canonpath __dev:[__dir.000000]__foo __dev:[__dir.][000000]__foo File::Spec->canonpath __dev:[__dir]__foo diff --git a/gnu/usr.bin/perl/vms/test.com b/gnu/usr.bin/perl/vms/test.com index aedcc92601a..3c5b49ec70e 100644 --- a/gnu/usr.bin/perl/vms/test.com +++ b/gnu/usr.bin/perl/vms/test.com @@ -16,9 +16,9 @@ $ oldmsg = F$Environment("Message") $ oldpriv = F$SetPrv("NOALL") ! downgrade privs for safety $ discard = F$SetPrv("NETMBX,TMPMBX") ! only need these to run tests $! -$! Process arguments. P1 is the file extension of the Perl images. P2, -$! when not empty, indicates that we are testing a version of Perl built for -$! the VMS debugger. The other arguments are passed directly to t/TEST. +$! Process arguments. P1 is the file extension of the Perl images. +$! P2, when not empty, indicates that we are testing a version of Perl built +$! for the VMS debugger. The other arguments are passed directly to t/TEST. $! $ exe = ".Exe" $ If p1.nes."" Then exe = p1 @@ -40,6 +40,9 @@ $ ndbg = "" $ if p2.nes."" then dbg = "dbg" $ if p2.nes."" then ndbg = "ndbg" $! +$! Run using "TEST." unless something else (e.g. "harness.") was specified. +$ If F$Type(PERL_TEST_DRIVER) .eqs. "" Then PERL_TEST_DRIVER == "TEST." +$! $! Make sure we are where we need to be. $ If F$Search("t.dir").nes."" $ Then @@ -73,7 +76,7 @@ $ testdir = "Directory/NoHead/NoTrail/Column=1" $ PerlShr_filespec = f$parse("Sys$Disk:[-]''dbg'PerlShr''exe'") $ Define 'dbg'Perlshr 'PerlShr_filespec' $ If F$Mode() .nes. "INTERACTIVE" Then Define/Nolog PERL_SKIP_TTY_TEST 1 -$ MCR Sys$Disk:[]Perl. "-I[-.lib]" TEST. "''p3'" "''p4'" "''p5'" "''p6'" +$ MCR Sys$Disk:[]Perl. "-I[-.lib]" 'PERL_TEST_DRIVER' "''p3'" "''p4'" "''p5'" "''p6'" "''p7'" $ goto wrapup $! $ Control_Y_exit: diff --git a/gnu/usr.bin/perl/vos/config.alpha.h b/gnu/usr.bin/perl/vos/config.alpha.h index 4ef35e5193b..fe75feff31a 100644 --- a/gnu/usr.bin/perl/vos/config.alpha.h +++ b/gnu/usr.bin/perl/vos/config.alpha.h @@ -7,7 +7,7 @@ * that running config_h.SH again will wipe out any changes you've made. * For a more permanent change edit config.sh and rerun config_h.SH. * - * \$Id: config.alpha.h,v 1.6 2004/08/09 18:10:36 millert Exp $ + * \$Id: config.alpha.h,v 1.7 2005/01/15 21:30:42 millert Exp $ */ /* @@ -1387,8 +1387,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "/system/ported/lib/perl5/5.8.5" /**/ -#define PRIVLIB_EXP "/system/ported/lib/perl5/5.8.5" /**/ +#define PRIVLIB "/system/ported/lib/perl5/5.8.6" /**/ +#define PRIVLIB_EXP "/system/ported/lib/perl5/5.8.6" /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1405,8 +1405,8 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -/*#define SITEARCH "/system/ported/lib/perl5/site_perl/5.8.5/hppa1.1" /**/ -/*#define SITEARCH_EXP "/system/ported/lib/perl5/site_perl/5.8.5/hppa1.1" /**/ +/*#define SITEARCH "/system/ported/lib/perl5/site_perl/5.8.6/hppa1.1" /**/ +/*#define SITEARCH_EXP "/system/ported/lib/perl5/site_perl/5.8.6/hppa1.1" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -1428,8 +1428,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "/system/ported/lib/perl5/site_perl/5.8.5" /**/ -#define SITELIB_EXP "/system/ported/lib/perl5/site_perl/5.8.5" /**/ +#define SITELIB "/system/ported/lib/perl5/site_perl/5.8.6" /**/ +#define SITELIB_EXP "/system/ported/lib/perl5/site_perl/5.8.6" /**/ #define SITELIB_STEM "/system/ported/lib/perl5/site_perl" /**/ /* PERL_VENDORARCH: @@ -3360,7 +3360,7 @@ /* PERL_XS_APIVERSION: * This variable contains the version of the oldest perl binary * compatible with the present perl. perl.c:incpush() and - * lib/lib.pm will automatically search in /system/ported/lib/perl5/site_perl/5.8.5/hppa1.1 for older + * lib/lib.pm will automatically search in /system/ported/lib/perl5/site_perl/5.8.6/hppa1.1 for older * directories across major versions back to xs_apiversion. * This is only useful if you have a perl library directory tree * structured like the default one. @@ -3379,7 +3379,7 @@ * compatible with the present perl. (That is, pure perl modules * written for pm_apiversion will still work for the current * version). perl.c:incpush() and lib/lib.pm will automatically - * search in /system/ported/lib/perl5/site_perl/5.8.5 for older directories across major versions + * search in /system/ported/lib/perl5/site_perl/5.8.6 for older directories across major versions * back to pm_apiversion. This is only useful if you have a perl * library directory tree structured like the default one. The * versioned site_perl library was introduced in 5.005, so that's diff --git a/gnu/usr.bin/perl/vos/config.ga.h b/gnu/usr.bin/perl/vos/config.ga.h index aeea13051c2..7cf908e9972 100644 --- a/gnu/usr.bin/perl/vos/config.ga.h +++ b/gnu/usr.bin/perl/vos/config.ga.h @@ -7,7 +7,7 @@ * that running config_h.SH again will wipe out any changes you've made. * For a more permanent change edit config.sh and rerun config_h.SH. * - * \$Id: config.ga.h,v 1.6 2004/08/09 18:10:36 millert Exp $ + * \$Id: config.ga.h,v 1.7 2005/01/15 21:30:42 millert Exp $ */ /* @@ -1387,8 +1387,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "/system/ported/lib/perl5/5.8.5" /**/ -#define PRIVLIB_EXP "/system/ported/lib/perl5/5.8.5" /**/ +#define PRIVLIB "/system/ported/lib/perl5/5.8.6" /**/ +#define PRIVLIB_EXP "/system/ported/lib/perl5/5.8.6" /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1405,8 +1405,8 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -/*#define SITEARCH "/system/ported/lib/perl5/site_perl/5.8.5/hppa1.1" /**/ -/*#define SITEARCH_EXP "/system/ported/lib/perl5/site_perl/5.8.5/hppa1.1" /**/ +/*#define SITEARCH "/system/ported/lib/perl5/site_perl/5.8.6/hppa1.1" /**/ +/*#define SITEARCH_EXP "/system/ported/lib/perl5/site_perl/5.8.6/hppa1.1" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -1428,8 +1428,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "/system/ported/lib/perl5/site_perl/5.8.5" /**/ -#define SITELIB_EXP "/system/ported/lib/perl5/site_perl/5.8.5" /**/ +#define SITELIB "/system/ported/lib/perl5/site_perl/5.8.6" /**/ +#define SITELIB_EXP "/system/ported/lib/perl5/site_perl/5.8.6" /**/ #define SITELIB_STEM "/system/ported/lib/perl5/site_perl" /**/ /* PERL_VENDORARCH: @@ -3360,7 +3360,7 @@ /* PERL_XS_APIVERSION: * This variable contains the version of the oldest perl binary * compatible with the present perl. perl.c:incpush() and - * lib/lib.pm will automatically search in /system/ported/lib/perl5/site_perl/5.8.5/hppa1.1 for older + * lib/lib.pm will automatically search in /system/ported/lib/perl5/site_perl/5.8.6/hppa1.1 for older * directories across major versions back to xs_apiversion. * This is only useful if you have a perl library directory tree * structured like the default one. @@ -3379,7 +3379,7 @@ * compatible with the present perl. (That is, pure perl modules * written for pm_apiversion will still work for the current * version). perl.c:incpush() and lib/lib.pm will automatically - * search in /system/ported/lib/perl5/site_perl/5.8.5 for older directories across major versions + * search in /system/ported/lib/perl5/site_perl/5.8.6 for older directories across major versions * back to pm_apiversion. This is only useful if you have a perl * library directory tree structured like the default one. The * versioned site_perl library was introduced in 5.005, so that's diff --git a/gnu/usr.bin/perl/win32/Makefile b/gnu/usr.bin/perl/win32/Makefile index e139903bbcf..9dc80ed8c29 100644 --- a/gnu/usr.bin/perl/win32/Makefile +++ b/gnu/usr.bin/perl/win32/Makefile @@ -32,7 +32,7 @@ INST_TOP = $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-#INST_VER = \5.8.5
+#INST_VER = \5.8.6
#
# Comment this out if you DON'T want your perl installation to have
@@ -326,7 +326,7 @@ ARCHNAME = $(ARCHNAME)-thread # VC 6.0 can load the socket dll on demand. Makes the test suite
# run in about 10% less time.
-DELAYLOAD = -DELAYLOAD:wsock32.dll -DELAYLOAD:shell32.dll delayimp.lib
+DELAYLOAD = -DELAYLOAD:ws2_32.dll -DELAYLOAD:shell32.dll delayimp.lib
!ENDIF
ARCHDIR = ..\lib\$(ARCHNAME)
@@ -412,7 +412,7 @@ BUILDOPT = $(BUILDOPT) -DPERL_MSVCRT_READFIX LIBBASEFILES = $(CRYPT_LIB) \
oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib \
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib \
- netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \
+ netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib \
version.lib
# win64 doesn't have some libs
@@ -839,10 +839,10 @@ CFG_VARS = \ "libpth=$(CCLIBDIR:"=\");$(EXTRALIBDIRS:"=\")" \
"libc=$(LIBC)" \
"make=$(MAKE_BARE)" \
+ "static_ext=$(STATIC_EXT)" \
"usethreads=$(USE_ITHREADS)" \
"use5005threads=$(USE_5005THREADS)" \
"useithreads=$(USE_ITHREADS)" \
- "usethreads=$(USE_5005THREADS)" \
"usemultiplicity=$(USE_MULTI)" \
"useperlio=$(USE_PERLIO)" \
"uselargefiles=$(USE_LARGE_FILES)" \
@@ -1074,7 +1074,7 @@ utils: $(PERLEXE) $(X2P) copy ..\README.vms ..\pod\perlvms.pod
copy ..\README.vos ..\pod\perlvos.pod
copy ..\README.win32 ..\pod\perlwin32.pod
- copy ..\pod\perl585delta.pod ..\pod\perldelta.pod
+ copy ..\pod\perl586delta.pod ..\pod\perldelta.pod
$(MAKE) -f ..\win32\pod.mak converters
cd ..\lib
$(PERLEXE) lib_pm.PL
diff --git a/gnu/usr.bin/perl/win32/config_H.bc b/gnu/usr.bin/perl/win32/config_H.bc index 8f44ea486db..fc3b9e1dcd1 100644 --- a/gnu/usr.bin/perl/win32/config_H.bc +++ b/gnu/usr.bin/perl/win32/config_H.bc @@ -7,7 +7,7 @@ * that running config_h.SH again will wipe out any changes you've made. * For a more permanent change edit undef and rerun config_h.SH. * - * $Id: config_H.bc,v 1.7 2004/04/07 21:33:12 millert Exp $ + * $Id: config_H.bc,v 1.8 2004/08/09 18:10:39 millert Exp $ */ /* @@ -1344,7 +1344,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.8.5\\lib\\MSWin32-x86-multi-thread" /**/ +#define ARCHLIB "c:\\perl\\5.8.6\\lib\\MSWin32-x86-multi-thread" /**/ /*#define ARCHLIB_EXP "" /**/ /* BIN: @@ -1355,8 +1355,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.8.5\\bin\\MSWin32-x86-multi-thread" /**/ -#define BIN_EXP "c:\\perl\\5.8.5\\bin\\MSWin32-x86-multi-thread" /**/ +#define BIN "c:\\perl\\5.8.6\\bin\\MSWin32-x86-multi-thread" /**/ +#define BIN_EXP "c:\\perl\\5.8.6\\bin\\MSWin32-x86-multi-thread" /**/ /* PERL_INC_VERSION_LIST: * This variable specifies the list of subdirectories in over @@ -1393,8 +1393,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\5.8.5\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.8.5")) /**/ +#define PRIVLIB "c:\\perl\\5.8.6\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.8.6")) /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1411,7 +1411,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.8.5\\lib\\MSWin32-x86-multi-thread" /**/ +#define SITEARCH "c:\\perl\\site\\5.8.6\\lib\\MSWin32-x86-multi-thread" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -1434,8 +1434,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "c:\\perl\\site\\5.8.5\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.8.5")) /**/ +#define SITELIB "c:\\perl\\site\\5.8.6\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.8.6")) /**/ #define SITELIB_STEM "" /**/ /* PERL_VENDORARCH: diff --git a/gnu/usr.bin/perl/win32/config_H.gc b/gnu/usr.bin/perl/win32/config_H.gc index 014f9db6849..dba32bd3ae3 100644 --- a/gnu/usr.bin/perl/win32/config_H.gc +++ b/gnu/usr.bin/perl/win32/config_H.gc @@ -7,7 +7,7 @@ * that running config_h.SH again will wipe out any changes you've made. * For a more permanent change edit undef and rerun config_h.SH. * - * $Id: config_H.gc,v 1.7 2004/04/07 21:33:12 millert Exp $ + * $Id: config_H.gc,v 1.8 2004/08/09 18:10:39 millert Exp $ */ /* @@ -1344,7 +1344,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.8.5\\lib\\MSWin32-x86-multi-thread" /**/ +#define ARCHLIB "c:\\perl\\5.8.6\\lib\\MSWin32-x86-multi-thread" /**/ /*#define ARCHLIB_EXP "" /**/ /* BIN: @@ -1355,8 +1355,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.8.5\\bin\\MSWin32-x86-multi-thread" /**/ -#define BIN_EXP "c:\\perl\\5.8.5\\bin\\MSWin32-x86-multi-thread" /**/ +#define BIN "c:\\perl\\5.8.6\\bin\\MSWin32-x86-multi-thread" /**/ +#define BIN_EXP "c:\\perl\\5.8.6\\bin\\MSWin32-x86-multi-thread" /**/ /* PERL_INC_VERSION_LIST: * This variable specifies the list of subdirectories in over @@ -1393,8 +1393,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\5.8.5\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.8.5")) /**/ +#define PRIVLIB "c:\\perl\\5.8.6\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.8.6")) /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1411,7 +1411,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.8.5\\lib\\MSWin32-x86-multi-thread" /**/ +#define SITEARCH "c:\\perl\\site\\5.8.6\\lib\\MSWin32-x86-multi-thread" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -1434,8 +1434,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "c:\\perl\\site\\5.8.5\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.8.5")) /**/ +#define SITELIB "c:\\perl\\site\\5.8.6\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.8.6")) /**/ #define SITELIB_STEM "" /**/ /* PERL_VENDORARCH: diff --git a/gnu/usr.bin/perl/win32/config_H.vc b/gnu/usr.bin/perl/win32/config_H.vc index ec38924c9db..be4a7778a7d 100644 --- a/gnu/usr.bin/perl/win32/config_H.vc +++ b/gnu/usr.bin/perl/win32/config_H.vc @@ -7,7 +7,7 @@ * that running config_h.SH again will wipe out any changes you've made. * For a more permanent change edit undef and rerun config_h.SH. * - * $Id: config_H.vc,v 1.7 2004/04/07 21:33:12 millert Exp $ + * $Id: config_H.vc,v 1.8 2004/08/09 18:10:39 millert Exp $ */ /* @@ -1344,7 +1344,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.8.5\\lib\\MSWin32-x86-multi-thread" /**/ +#define ARCHLIB "c:\\perl\\5.8.6\\lib\\MSWin32-x86-multi-thread" /**/ /*#define ARCHLIB_EXP "" /**/ /* BIN: @@ -1355,8 +1355,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.8.5\\bin\\MSWin32-x86-multi-thread" /**/ -#define BIN_EXP "c:\\perl\\5.8.5\\bin\\MSWin32-x86-multi-thread" /**/ +#define BIN "c:\\perl\\5.8.6\\bin\\MSWin32-x86-multi-thread" /**/ +#define BIN_EXP "c:\\perl\\5.8.6\\bin\\MSWin32-x86-multi-thread" /**/ /* PERL_INC_VERSION_LIST: * This variable specifies the list of subdirectories in over @@ -1393,8 +1393,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "c:\\perl\\5.8.5\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.8.5")) /**/ +#define PRIVLIB "c:\\perl\\5.8.6\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.8.6")) /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1411,7 +1411,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.8.5\\lib\\MSWin32-x86-multi-thread" /**/ +#define SITEARCH "c:\\perl\\site\\5.8.6\\lib\\MSWin32-x86-multi-thread" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -1434,8 +1434,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "c:\\perl\\site\\5.8.5\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.8.5")) /**/ +#define SITELIB "c:\\perl\\site\\5.8.6\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.8.6")) /**/ #define SITELIB_STEM "" /**/ /* PERL_VENDORARCH: diff --git a/gnu/usr.bin/perl/win32/dl_win32.xs b/gnu/usr.bin/perl/win32/dl_win32.xs index 69910dd5390..4ff00a1f8ef 100644 --- a/gnu/usr.bin/perl/win32/dl_win32.xs +++ b/gnu/usr.bin/perl/win32/dl_win32.xs @@ -68,7 +68,7 @@ static int dl_static_linked(char *filename) { char **p; - char* ptr; + char *ptr, *hptr; static char subStr[] = "/auto/"; char szBuffer[MAX_PATH]; @@ -90,7 +90,14 @@ dl_static_linked(char *filename) ptr = szBuffer; for (p = staticlinkmodules; *p;p++) { - if (strstr(ptr, *p)) return 1; + if (hptr = strstr(ptr, *p)) { + /* found substring, need more detailed check if module name match */ + if (hptr==ptr) { + return strcmp(ptr, *p)==0; + } + if (hptr[strlen(*p)] == 0) + return hptr[-1]=='/'; + } }; return 0; } diff --git a/gnu/usr.bin/perl/win32/makefile.mk b/gnu/usr.bin/perl/win32/makefile.mk index 701c69fe768..a6b1776f0b8 100644 --- a/gnu/usr.bin/perl/win32/makefile.mk +++ b/gnu/usr.bin/perl/win32/makefile.mk @@ -34,7 +34,7 @@ INST_TOP *= $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-#INST_VER *= \5.8.5
+#INST_VER *= \5.8.6
#
# Comment this out if you DON'T want your perl installation to have
@@ -165,7 +165,14 @@ CRYPT_SRC *= fcrypt.c # extensions if you change the default. Currently, this cannot be enabled
# if you ask for USE_IMP_SYS above.
#
-#PERL_MALLOC *= define
+PERL_MALLOC *= define
+
+#
+# set this to enable debugging mstats
+# This must be enabled to use the Devel::Peek::mstat() function. This cannot
+# be enabled without PERL_MALLOC as well.
+#
+DEBUG_MSTATS = define
#
# set the install locations of the compiler include/libraries
@@ -255,6 +262,19 @@ USE_PERLIO *= undef USE_LARGE_FILES *= undef
USE_PERLCRT *= undef
+.IF "$(PERL_MALLOC)" == "undef"
+PERL_MALLOC = undef
+DEBUG_MSTATS = undef
+.ENDIF
+
+.IF "$(DEBUG_MSTATS)" == "undef"
+DEBUG_MSTATS = undef
+.ENDIF
+
+.IF "$(DEBUG_MSTATS)" == "define"
+BUILDOPT += -DPERL_DEBUGGING_MSTATS
+.ENDIF
+
.IF "$(USE_IMP_SYS)$(USE_MULTI)$(USE_5005THREADS)" == "defineundefundef"
USE_MULTI != define
.ENDIF
@@ -309,7 +329,7 @@ ARCHNAME !:= $(ARCHNAME)-thread # VC 6.0 can load the socket dll on demand. Makes the test suite
# run in about 10% less time.
-DELAYLOAD *= -DELAYLOAD:wsock32.dll -DELAYLOAD:shell32.dll delayimp.lib
+DELAYLOAD *= -DELAYLOAD:ws2_32.dll -DELAYLOAD:shell32.dll delayimp.lib
.IF "$(CFG)" == "Debug"
.ELSE
@@ -419,7 +439,7 @@ LIBC = -lmsvcrt LIBFILES = $(CRYPT_LIB) $(LIBC) \
-lmoldname -lkernel32 -luser32 -lgdi32 \
-lwinspool -lcomdlg32 -ladvapi32 -lshell32 -lole32 \
- -loleaut32 -lnetapi32 -luuid -lwsock32 -lmpr \
+ -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr \
-lwinmm -lversion -lodbc32
.IF "$(CFG)" == "Debug"
@@ -503,7 +523,7 @@ BUILDOPT += -DPERL_MSVCRT_READFIX LIBBASEFILES = $(CRYPT_LIB) \
oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib \
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib \
- netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \
+ netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib \
version.lib
# win64 doesn't have some libs
@@ -858,7 +878,6 @@ CFG_VARS = \ usethreads=$(USE_ITHREADS) ~ \
use5005threads=$(USE_5005THREADS) ~ \
useithreads=$(USE_ITHREADS) ~ \
- usethreads=$(USE_5005THREADS) ~ \
usemultiplicity=$(USE_MULTI) ~ \
useperlio=$(USE_PERLIO) ~ \
uselargefiles=$(USE_LARGE_FILES) ~ \
@@ -1014,9 +1033,9 @@ $(MINIWIN32_OBJ) : $(CORE_NOCFG_H) perllib$(o) : perllib.c .\perlhost.h .\vdir.h .\vmem.h
.IF "$(USE_IMP_SYS)" == "define"
- $(CC) -c -I. $(CFLAGS_O) $(CXX_FLAG) $(OBJOUT_FLAG)$@ perllib.c
+ $(CC) -c -I. -DWITH_STATIC $(CFLAGS_O) $(CXX_FLAG) $(OBJOUT_FLAG)$@ perllib.c
.ELSE
- $(CC) -c -I. $(CFLAGS_O) $(OBJOUT_FLAG)$@ perllib.c
+ $(CC) -c -I. -DWITH_STATIC $(CFLAGS_O) $(OBJOUT_FLAG)$@ perllib.c
.ENDIF
# 1. we don't want to rebuild miniperl.exe when config.h changes
@@ -1032,10 +1051,11 @@ $(DLL_OBJ) : $(CORE_H) $(X2P_OBJ) : $(CORE_H)
perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym ..\pp.sym ..\makedef.pl
+ $(MINIPERL) -I..\lib buildext.pl --create-perllibst-h $(STATIC_EXT)
$(MINIPERL) -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) \
$(BUILDOPT) CCTYPE=$(CCTYPE) > perldll.def
-$(PERLDLL): perldll.def $(PERLDLL_OBJ) $(PERLDLL_RES)
+$(PERLDLL): perldll.def $(PERLDLL_OBJ) $(PERLDLL_RES) Extensions_static
.IF "$(CCTYPE)" == "BORLAND"
$(LINK32) -Tpd -ap $(BLINK_FLAGS) \
@$(mktmp c0d32$(o) $(PERLDLL_OBJ:s,\,\\)\n \
@@ -1056,11 +1076,13 @@ $(PERLDLL): perldll.def $(PERLDLL_OBJ) $(PERLDLL_RES) perl.exp $(LKPOST))
.ELSE
$(LINK32) -dll -def:perldll.def -out:$@ \
+ $(shell $(MINIPERL) -I..\lib buildext.pl --list-static-libs) \
@$(mktmp -base:0x28000000 $(BLINK_FLAGS) $(DELAYLOAD) $(LIBFILES) \
$(PERLDLL_RES) $(PERLDLL_OBJ:s,\,\\))
.ENDIF
$(XCOPY) $(PERLIMPLIB) $(COREDIR)
+
$(PERLEXE_ICO): $(MINIPERL) makeico.pl
$(MINIPERL) makeico.pl > $@
@@ -1136,8 +1158,12 @@ $(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs #----------------------------------------------------------------------------------
Extensions : buildext.pl $(PERLDEP) $(CONFIGPM)
- $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR)
- $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext
+ $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --dynamic
+ $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic
+
+Extensions_static : buildext.pl
+ $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --static
+ $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --static
# Note: The next two targets explicitly remove a "blibdirs.exists" file that
# currerntly gets left behind, until CPAN RT Ticket #5616 is resolved.
@@ -1201,7 +1227,7 @@ utils: $(PERLEXE) $(X2P) copy ..\README.vms ..\pod\perlvms.pod
copy ..\README.vos ..\pod\perlvos.pod
copy ..\README.win32 ..\pod\perlwin32.pod
- copy ..\pod\perl585delta.pod ..\pod\perldelta.pod
+ copy ..\pod\perl586delta.pod ..\pod\perldelta.pod
cd ..\pod && $(MAKE) -f ..\win32\pod.mak converters
cd ..\lib && $(PERLEXE) lib_pm.PL
$(PERLEXE) $(PL2BAT) $(UTILS)
@@ -1280,6 +1306,7 @@ distclean: realclean -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
-del /f $(CONFIGPM)
-del /f bin\*.bat
+ -del /f perllibst.h
-del /f $(PERLEXE_ICO) perl.base
-cd .. && del /s *$(a) *.map *.pdb *.ilk *.bs *$(o) .exists pm_to_blib
-cd $(EXTDIR) && del /s *.def Makefile Makefile.old
diff --git a/gnu/usr.bin/perl/win32/perllib.c b/gnu/usr.bin/perl/win32/perllib.c index 4aeb7413dad..b4237366f13 100644 --- a/gnu/usr.bin/perl/win32/perllib.c +++ b/gnu/usr.bin/perl/win32/perllib.c @@ -16,10 +16,20 @@ /* Register any extra external extensions */ char *staticlinkmodules[] = { "DynaLoader", + /* other similar records will be included from "perllibst.h" */ +#ifdef WITH_STATIC +#define STATIC1 +#include "perllibst.h" +#endif NULL, }; EXTERN_C void boot_DynaLoader (pTHX_ CV* cv); +/* other similar records will be included from "perllibst.h" */ +#ifdef WITH_STATIC +#define STATIC2 +#include "perllibst.h" +#endif static void xs_init(pTHX) @@ -27,6 +37,11 @@ xs_init(pTHX) char *file = __FILE__; dXSUB_SYS; newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); + /* other similar records will be included from "perllibst.h" */ +#ifdef WITH_STATIC +#define STATIC3 +#include "perllibst.h" +#endif } #ifdef PERL_IMPLICIT_SYS diff --git a/gnu/usr.bin/perl/win32/pod.mak b/gnu/usr.bin/perl/win32/pod.mak index 88abdeb4990..031079e419c 100644 --- a/gnu/usr.bin/perl/win32/pod.mak +++ b/gnu/usr.bin/perl/win32/pod.mak @@ -29,6 +29,7 @@ POD = \ perl583delta.pod \ perl584delta.pod \ perl585delta.pod \ + perl586delta.pod \ perl58delta.pod \ perlapi.pod \ perlapio.pod \ @@ -130,6 +131,7 @@ MAN = \ perl583delta.man \ perl584delta.man \ perl585delta.man \ + perl586delta.man \ perl58delta.man \ perlapi.man \ perlapio.man \ @@ -231,6 +233,7 @@ HTML = \ perl583delta.html \ perl584delta.html \ perl585delta.html \ + perl586delta.html \ perl58delta.html \ perlapi.html \ perlapio.html \ @@ -332,6 +335,7 @@ TEX = \ perl583delta.tex \ perl584delta.tex \ perl585delta.tex \ + perl586delta.tex \ perl58delta.tex \ perlapi.tex \ perlapio.tex \ diff --git a/gnu/usr.bin/perl/win32/win32.c b/gnu/usr.bin/perl/win32/win32.c index 23e9e7f5386..b01e46a9fed 100644 --- a/gnu/usr.bin/perl/win32/win32.c +++ b/gnu/usr.bin/perl/win32/win32.c @@ -4155,7 +4155,6 @@ static char *base = NULL; /* XXX threadead */ static char *reserved = NULL; /* XXX threadead */ static char *brk = NULL; /* XXX threadead */ static DWORD pagesize = 0; /* XXX threadead */ -static DWORD allocsize = 0; /* XXX threadead */ void * sbrk(ptrdiff_t need) @@ -4168,28 +4167,34 @@ sbrk(ptrdiff_t need) * call the OS to commit just one page ... */ pagesize = info.dwPageSize << 3; - allocsize = info.dwAllocationGranularity; } - /* This scheme fails eventually if request for contiguous - * block is denied so reserve big blocks - this is only - * address space not memory ... - */ if (brk+need >= reserved) { - DWORD size = 64*1024*1024; + DWORD size = brk+need-reserved; char *addr; + char *prev_committed = NULL; if (committed && reserved && committed < reserved) { /* Commit last of previous chunk cannot span allocations */ addr = (char *) VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE); if (addr) + { + /* Remember where we committed from in case we want to decommit later */ + prev_committed = committed; committed = reserved; + } } /* Reserve some (more) space + * Contiguous blocks give us greater efficiency, so reserve big blocks - + * this is only address space not memory... * Note this is a little sneaky, 1st call passes NULL as reserved * so lets system choose where we start, subsequent calls pass * the old end address so ask for a contiguous block */ +sbrk_reserve: + if (size < 64*1024*1024) + size = 64*1024*1024; + size = ((size + pagesize - 1) / pagesize) * pagesize; addr = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS); if (addr) { @@ -4201,6 +4206,19 @@ sbrk(ptrdiff_t need) if (!brk) brk = committed; } + else if (reserved) + { + /* The existing block could not be extended far enough, so decommit + * anything that was just committed above and start anew */ + if (prev_committed) + { + if (!VirtualFree(prev_committed,reserved-prev_committed,MEM_DECOMMIT)) + return (void *) -1; + } + reserved = base = committed = brk = NULL; + size = need; + goto sbrk_reserve; + } else { return (void *) -1; @@ -4211,11 +4229,12 @@ sbrk(ptrdiff_t need) if (brk > committed) { DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize; - char *addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE); + char *addr; + if (committed+size > reserved) + size = reserved-committed; + addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE); if (addr) - { - committed += size; - } + committed += size; else return (void *) -1; } @@ -4807,13 +4826,15 @@ XS(w32_GetFullPathName) SV *fullpath; char *filepart; DWORD len; + STRLEN filename_len; + char *filename_p; if (items != 1) Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)"); filename = ST(0); - fullpath = sv_mortalcopy(filename); - SvUPGRADE(fullpath, SVt_PV); + filename_p = SvPV(filename, filename_len); + fullpath = sv_2mortal(newSVpvn(filename_p, filename_len)); if (!SvPVX(fullpath) || !SvLEN(fullpath)) XSRETURN_UNDEF; diff --git a/gnu/usr.bin/perl/win32/win32sck.c b/gnu/usr.bin/perl/win32/win32sck.c index 9f47f50208c..e751dcd3cae 100644 --- a/gnu/usr.bin/perl/win32/win32sck.c +++ b/gnu/usr.bin/perl/win32/win32sck.c @@ -16,6 +16,8 @@ #define Win32_Winsock #endif #include <windows.h> +#include <ws2spi.h> + #include "EXTERN.h" #include "perl.h" @@ -86,11 +88,11 @@ start_sockets(void) * initalize the winsock interface and insure that it is * cleaned up at exit. */ - version = 0x101; + version = 0x2; if(ret = WSAStartup(version, &retdata)) Perl_croak_nocontext("Unable to locate winsock library!\n"); if(retdata.wVersion != version) - Perl_croak_nocontext("Could not find version 1.1 of winsock dll\n"); + Perl_croak_nocontext("Could not find version 2.0 of winsock dll\n"); /* atexit((void (*)(void)) EndSockets); */ wsock_started = 1; @@ -103,14 +105,6 @@ set_socktype(void) #if defined(USE_5005THREADS) || defined(USE_ITHREADS) dTHX; if (!w32_init_socktype) { -#endif - int iSockOpt = SO_SYNCHRONOUS_NONALERT; - /* - * Enable the use of sockets as filehandles - */ - setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, - (char *)&iSockOpt, sizeof(iSockOpt)); -#if defined(USE_5005THREADS) || defined(USE_ITHREADS) w32_init_socktype = 1; } #endif @@ -399,6 +393,70 @@ win32_closesocket(SOCKET s) return r; } +#ifdef USE_SOCKETS_AS_HANDLES +#define WIN32_OPEN_SOCKET(af, type, protocol) open_ifs_socket(af, type, protocol) + +void +convert_proto_info_w2a(WSAPROTOCOL_INFOW *in, WSAPROTOCOL_INFOA *out) +{ + Copy(in, out, 1, WSAPROTOCOL_INFOA); + wcstombs(out->szProtocol, in->szProtocol, sizeof(out->szProtocol)); +} + +SOCKET +open_ifs_socket(int af, int type, int protocol) +{ + dTHX; + char *s; + unsigned long proto_buffers_len = 0; + int error_code; + SOCKET out = INVALID_SOCKET; + + if ((s = PerlEnv_getenv("PERL_ALLOW_NON_IFS_LSP")) && atoi(s)) + return WSASocket(af, type, protocol, NULL, 0, 0); + + if (WSCEnumProtocols(NULL, NULL, &proto_buffers_len, &error_code) == SOCKET_ERROR + && error_code == WSAENOBUFS) + { + WSAPROTOCOL_INFOW *proto_buffers; + int protocols_available = 0; + + New(1, proto_buffers, proto_buffers_len / sizeof(WSAPROTOCOL_INFOW), + WSAPROTOCOL_INFOW); + + if ((protocols_available = WSCEnumProtocols(NULL, proto_buffers, + &proto_buffers_len, &error_code)) != SOCKET_ERROR) + { + int i; + for (i = 0; i < protocols_available; i++) + { + WSAPROTOCOL_INFOA proto_info; + + if ((af != AF_UNSPEC && af != proto_buffers[i].iAddressFamily) + || (type != proto_buffers[i].iSocketType) + || (protocol != 0 && protocol != proto_buffers[i].iProtocol)) + continue; + + if ((proto_buffers[i].dwServiceFlags1 & XP1_IFS_HANDLES) == 0) + continue; + + convert_proto_info_w2a(&(proto_buffers[i]), &proto_info); + + out = WSASocket(af, type, protocol, &proto_info, 0, 0); + break; + } + } + + Safefree(proto_buffers); + } + + return out; +} + +#else +#define WIN32_OPEN_SOCKET(af, type, protocol) socket(af, type, protocol) +#endif + SOCKET win32_socket(int af, int type, int protocol) { @@ -408,7 +466,8 @@ win32_socket(int af, int type, int protocol) SOCKET_TEST(s = socket(af, type, protocol), INVALID_SOCKET); #else StartSockets(); - if((s = socket(af, type, protocol)) == INVALID_SOCKET) + + if((s = WIN32_OPEN_SOCKET(af, type, protocol)) == INVALID_SOCKET) errno = WSAGetLastError(); else s = OPEN_SOCKET(s); |