From: Nick Ing-Simmons Date: Fri, 6 Jul 2001 16:27:40 +0000 (+0000) Subject: Integrate mainline X-Git-Tag: perl-5.7.2~6^2~9 X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/afd1eb533c8ea286efcac6fd054ae7cebaf0dfe3 Integrate mainline p4raw-id: //depot/perlio@11183 --- diff --git a/AUTHORS b/AUTHORS index 8e0a16e..c06cb7b 100644 --- a/AUTHORS +++ b/AUTHORS @@ -433,7 +433,6 @@ Mike Stok Mike W Ellwood Milton Hankins Milton L. Hankins -Molnar Laszlo Murray Nesbitt Nathan Kurz Nathan Torkington diff --git a/Changes b/Changes index 6505845..804fd3c 100644 --- a/Changes +++ b/Changes @@ -31,6 +31,904 @@ or any other branch. Version v5.7.1 Development release working toward v5.8 -------------- ____________________________________________________________________________ +[ 11180] By: jhi on 2001/07/06 13:20:08 + Log: Regen toc. + Branch: perl + ! pod/perltoc.pod +____________________________________________________________________________ +[ 11179] By: jhi on 2001/07/06 12:57:13 + Log: Nit from Abhijit. + Branch: perl + ! lib/CPAN.pm +____________________________________________________________________________ +[ 11178] By: jhi on 2001/07/06 12:53:04 + Log: Retract #11172. + Branch: perl + ! t/op/method.t +____________________________________________________________________________ +[ 11177] By: jhi on 2001/07/06 12:44:51 + Log: Subject: [PATCH lib/Cwd.pm] QNX patch extended for NTO + From: Norton Allen + Date: Fri, 6 Jul 2001 09:39:57 -0400 (edt) + Message-Id: <200107061339.JAA12582@bottesini.harvard.edu> + Branch: perl + ! lib/Cwd.pm +____________________________________________________________________________ +[ 11176] By: jhi on 2001/07/06 12:42:45 + Log: Subject: [PATCH lib/Cwd.pm] QNX patch extended for NTO + From: Norton Allen + Date: Fri, 6 Jul 2001 09:39:57 -0400 (edt) + Message-Id: <200107061339.JAA12582@bottesini.harvard.edu> + Branch: perl + ! utf8.h +____________________________________________________________________________ +[ 11175] By: jhi on 2001/07/06 12:29:56 + Log: Retract #11165 since Sarathy pointed out it'll not + work properly under threads, the problem should be + solved using "the savestack, either via SSNEW() or + using a newSVpv()+SAVEFREESV() combo." + Branch: perl + ! ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 11174] By: jhi on 2001/07/06 12:27:31 + Log: Retract #11125 since NI-S pointed out it'll not work in + cases where the extension has their own handcrafted INC + et alia. + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 11173] By: jhi on 2001/07/06 12:20:50 + Log: Subject: RE: [PATCH] -I and MakeMaker again + From: "Konovalov, Vadim Vladimirovich (Vadim)" + Date: Fri, 6 Jul 2001 09:18:29 +0200 + Message-ID: + Branch: perl + ! lib/ExtUtils/MM_NW5.pm lib/ExtUtils/MM_VMS.pm + ! lib/ExtUtils/MM_Win32.pm +____________________________________________________________________________ +[ 11172] By: jhi on 2001/07/06 12:18:39 + Log: (Retracted by #11178) + Subject: [PATCH t/op/method.t] SUPER:: strangeness + From: Piers Cawley + Date: 06 Jul 2001 10:49:01 +0100 + Message-ID: + Branch: perl + ! t/op/method.t +____________________________________________________________________________ +[ 11171] By: jhi on 2001/07/06 01:38:55 + Log: VOS README update from Paul Green. + Branch: perl + ! README.vos +____________________________________________________________________________ +[ 11170] By: jhi on 2001/07/06 01:19:33 + Log: Subject: [PATCH README.qnx hints/qnx.sh] + From: Norton Allen + Message-Id: <200107051755.NAA21422@bottesini.harvard.edu> + Date: Thu, 5 Jul 2001 13:55:11 -0400 (edt) + Branch: perl + ! README.qnx hints/qnx.sh +____________________________________________________________________________ +[ 11169] By: jhi on 2001/07/06 01:17:43 + Log: Subject: [PATCH] Doc patch for Tie::Hash + From: Artur Bergman + Date: Thu, 05 Jul 2001 22:51:18 +0200 + Message-ID: + Branch: perl + ! lib/Tie/Hash.pm +____________________________________________________________________________ +[ 11168] By: jhi on 2001/07/06 01:16:27 + Log: Subject: [PATCH] perlfaq4.pod + From: "Liney, Dave" + Message-ID: <1BB544A41666D311836C00902751FF6D01FD2D07@LONEX02> + Date: Thu, 5 Jul 2001 18:44:10 +0100 + Branch: perl + ! pod/perlfaq4.pod +____________________________________________________________________________ +[ 11167] By: jhi on 2001/07/06 01:14:41 + Log: Subject: [PATCH B::Deparse] Make warnings handling more robust + From: Robin Houston + Date: Thu, 5 Jul 2001 18:33:21 +0100 + Message-ID: <20010705183321.A27345@robin.kitsite.com> + Branch: perl + ! ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 11166] By: jhi on 2001/07/06 01:11:50 + Log: Subject: Re: [PATCH] mkdir() mode argument is missing initial 0 + From: Abhijit Menon-Sen + Date: Fri, 6 Jul 2001 01:26:32 +0530 + Message-ID: <20010706012632.A28327@lustre.dyn.wiw.org> + Branch: perl + ! dump.c op.c op.h opcode.h opcode.pl pod/perldiag.pod pp.sym + ! pp_proto.h t/lib/warnings/op t/lib/warnings/toke toke.c + ! warnings.pl +____________________________________________________________________________ +[ 11165] By: jhi on 2001/07/06 00:19:26 + Log: (Retracted by #11175) + Subject: [PATCH ext/POSIX/POSIX.pm] Re: sigaction.t under QNX + From: Norton Allen + Message-Id: <200107051734.NAA13375@bottesini.harvard.edu> + Date: Thu, 5 Jul 2001 13:34:51 -0400 (edt) + Branch: perl + ! ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 11164] By: jhi on 2001/07/06 00:14:57 + Log: Unterminated C< (noticed by Richard Hatch), and few other + small Unicode doc tweaks. + Branch: perl + ! pod/perlretut.pod +____________________________________________________________________________ +[ 11163] By: jhi on 2001/07/05 19:33:34 + Log: More flexible argument understanding; add charblocks() and + charscripts(); make charblock() and charscript() two-way; + add charinrange(); separate the $Unicode::UCD::VERSION and + the version of the Unicode by adding UnicodeVersion(). + Branch: perl + ! lib/Unicode/UCD.pm lib/Unicode/UCD.t +____________________________________________________________________________ +[ 11162] By: jhi on 2001/07/05 13:38:36 + Log: Update Unicode::UCD on \p{In...}. + Branch: perl + ! lib/Unicode/UCD.pm +____________________________________________________________________________ +[ 11161] By: jhi on 2001/07/05 13:26:00 + Log: Subject: Re: [PATCH lib/ExtUtils.t] Extra Files for QNX + From: Norton Allen + Date: Thu, 5 Jul 2001 09:57:14 -0400 (edt) + Message-Id: <200107051357.JAA06285@bottesini.harvard.edu> + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 11160] By: jhi on 2001/07/05 13:06:53 + Log: POSIX-BC tweaks from Thomas Dorner. + Branch: perl + ! hints/posix-bc.sh perlio.h +____________________________________________________________________________ +[ 11159] By: jhi on 2001/07/05 04:17:18 + Log: Module updates for the delta. + Branch: perl + ! pod/perl572delta.pod +____________________________________________________________________________ +[ 11158] By: jhi on 2001/07/05 03:45:19 + Log: Subject: [PATCH ext/IO/lib/IO/t/io_sock.t] for QNX + From: Norton Allen + Message-Id: <200107050259.WAA06843@bottesini.harvard.edu> + Date: Wed, 4 Jul 2001 22:59:00 -0400 (edt) + Branch: perl + ! ext/IO/lib/IO/t/io_sock.t +____________________________________________________________________________ +[ 11157] By: jhi on 2001/07/05 03:44:19 + Log: Subject: [PATCH perldiag.pod] Quick fixes + From: Simon Cozens + Date: Wed, 4 Jul 2001 20:22:12 +0100 + Message-ID: <20010704202212.A3690@deep-dark-truthful-mirror> + Branch: perl + ! pod/perldiag.pod +____________________________________________________________________________ +[ 11156] By: jhi on 2001/07/05 03:43:28 + Log: Subject: [PATCH perl@11099]Re: [ID 20010704.003] Taint mode breaks global match + From: Radu Greab + Date: Wed, 4 Jul 2001 22:13:31 +0300 + Message-ID: <15171.27355.895094.128142@ix.netsoft.ro> + Branch: perl + ! op.c sv.c t/op/pos.t +____________________________________________________________________________ +[ 11155] By: jhi on 2001/07/05 03:40:24 + Log: Subject: [PATCH] -I and MakeMaker again + From: Michael G Schwern + Date: Wed, 4 Jul 2001 15:03:07 -0400 + Message-ID: <20010704150307.I20340@blackrider> + + (and retract #11145) + Branch: perl + ! ext/util/make_ext lib/ExtUtils/MM_Unix.pm + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 11154] By: jhi on 2001/07/05 03:32:43 + Log: Subject: Re: PERFORCE change 11142 for review + From: "Philip Newton" + Date: Wed, 4 Jul 2001 20:46:26 +0200 + Message-Id: <200107041841.VAA25380@taas.iki.fi> + Branch: perl + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 11153] By: jhi on 2001/07/05 03:29:21 + Log: Subject: Re: [PATCH 2 pl2pm.PL] (was Re: [PATCH pl2pm.PL] Make pl2pm be nice with 'strict' and 'warnings') + From: Jonathan Stowe + Date: Mon, 2 Jul 2001 20:45:53 +0100 (BST) + Message-ID: + Branch: perl + ! utils/pl2pm.PL +____________________________________________________________________________ +[ 11152] By: gsar on 2001/07/05 00:52:57 + Log: fix the binary compatibility issue when building with/without + usemymalloc by exporting Perl_malloc() et al as simple wrappers + around the system functions (this allows most extensions built + using one mode to coexist with perls built in the other mode) + + XXX the Perl_mfree() wrapper might need to do return(free()) on + platforms where Free_t isn't "void" + Branch: perl + ! embed.h embed.pl makedef.pl proto.h util.c +____________________________________________________________________________ +[ 11151] By: gsar on 2001/07/05 00:42:49 + Log: perl built with USE_ITHREADS can deadlock during fork() or backticks + since it doesn't ensure threads other than the one calling fork() + aren't holding any locks; the fix is to use pthread_atfork() to + hold global locks + + building perl with -Dusemymalloc exacerbates the problem since + Perl_malloc() holds a mutex, and perl's exec() calls New() + + XXX the code in win32thread.h may be needed on platforms that have + no pthread_atfork() + Branch: perl + ! perl.c thread.h win32/win32thread.h +____________________________________________________________________________ +[ 11150] By: pudge on 2001/07/04 20:07:54 + Log: Integrate #11009 from maintperl. + Branch: maint-5.6/macperl + !> lib/ExtUtils/Manifest.pm +____________________________________________________________________________ +[ 11149] By: pudge on 2001/07/04 19:54:46 + Log: Flexing my Perforce muscles. + Branch: maint-5.6/macperl + ! README.macos +____________________________________________________________________________ +[ 11148] By: jhi on 2001/07/04 17:14:51 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 11147] By: jhi on 2001/07/04 16:41:25 + Log: Metaconfig unit change for #11146. + Branch: metaconfig/U/perl + ! d_fcntl_can_lock.U +____________________________________________________________________________ +[ 11146] By: jhi on 2001/07/04 16:36:31 + Log: Somehow the #ifdefs of the added code (in #11093) made + HP-UX to fail the fcntl locking test, without the ifdefs + the test seems to be working again. Reason unknown: + HP-UX cc doesn't complain either way. + Branch: perl + ! Configure +____________________________________________________________________________ +[ 11145] By: jhi on 2001/07/04 16:08:00 + Log: PERLRUNINST needed in some spots. + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 11144] By: jhi on 2001/07/04 16:07:35 + Log: gcc -Wall nit. + Branch: perl + ! pp_hot.c +____________________________________________________________________________ +[ 11143] By: jhi on 2001/07/04 15:08:26 + Log: When removing tests updating the test count is a good idea, too. + Branch: perl + ! lib/Net/t/require.t +____________________________________________________________________________ +[ 11142] By: jhi on 2001/07/04 14:57:51 + Log: Document #11134 and add the new symbols to the list of + of MakeMaker known ones. + Branch: perl + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 11141] By: jhi on 2001/07/04 14:34:11 + Log: Microperl update. + Branch: perl + ! uconfig.h +____________________________________________________________________________ +[ 11140] By: jhi on 2001/07/04 14:32:27 + Log: Update the libnet tests as per #11138. + Branch: perl + - lib/Net/t/ph.t + ! MANIFEST lib/Net/t/require.t +____________________________________________________________________________ +[ 11139] By: jhi on 2001/07/04 14:14:33 + Log: Regen toc and modlib. + Branch: perl + ! pod/perlmodlib.pod pod/perltoc.pod +____________________________________________________________________________ +[ 11138] By: jhi on 2001/07/04 14:10:38 + Log: Remove DummyInetd, PH, and SNPP from the libnet, as per + Graham's request. + Branch: perl + - lib/Net/DummyInetd.pm lib/Net/PH.pm lib/Net/SNPP.pm + ! MANIFEST +____________________________________________________________________________ +[ 11137] By: jhi on 2001/07/04 14:06:35 + Log: Add the OS/390 harness results to the delta. + Branch: perl + ! pod/perl572delta.pod +____________________________________________________________________________ +[ 11136] By: jhi on 2001/07/04 13:59:01 + Log: Avoid the two study tests in OS/390 until the bug has been solved. + Branch: perl + ! t/op/study.t +____________________________________________________________________________ +[ 11135] By: jhi on 2001/07/04 13:49:08 + Log: DOS/DJGPP tweaks from Laszlo Molnar. + Branch: perl + ! AUTHORS djgpp/djgppsed.sh hints/dos_djgpp.sh t/op/write.t +____________________________________________________________________________ +[ 11134] By: jhi on 2001/07/04 13:47:46 + Log: Subject: [PATCH lib/ExtUtils/MM_Unix.pm and others] Fixing extra -I's with PERL_CORE + From: Michael G Schwern + Date: Wed, 4 Jul 2001 00:01:16 -0400 + Message-ID: <20010704000116.C591@blackrider> + Branch: perl + ! ext/util/make_ext lib/ExtUtils.t lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 11133] By: jhi on 2001/07/04 01:55:20 + Log: The #11132 missed singleton characters (not part + of a unilo..unihi range) in Unicode scripts. + Branch: perl + ! lib/unicode/In/0.pl lib/unicode/In/1.pl lib/unicode/In/10.pl + ! lib/unicode/In/11.pl lib/unicode/In/12.pl lib/unicode/In/13.pl + ! lib/unicode/In/15.pl lib/unicode/In/16.pl lib/unicode/In/17.pl + ! lib/unicode/In/18.pl lib/unicode/In/19.pl lib/unicode/In/20.pl + ! lib/unicode/In/21.pl lib/unicode/In/24.pl lib/unicode/In/29.pl + ! lib/unicode/In/3.pl lib/unicode/In/30.pl lib/unicode/In/34.pl + ! lib/unicode/In/35.pl lib/unicode/In/37.pl lib/unicode/In/39.pl + ! lib/unicode/In/4.pl lib/unicode/In/5.pl lib/unicode/In/6.pl + ! lib/unicode/In/8.pl lib/unicode/In/9.pl lib/unicode/Scripts.pl + ! lib/unicode/mktables.PL t/op/pat.t +____________________________________________________________________________ +[ 11132] By: jhi on 2001/07/04 01:32:11 + Log: Support preferentially the Unicode 'scripts' definition + in the \p{In...} notation since according to Unicode the + scripts concept is more natural for matching than using + the somewhat artificial block names. The block names are + still available, though, and if there's a name conflict, + the scripts one wins and the blocks one has to do with + 'Block' appended to its name. For more information see + + http://www.unicode.org/unicode/reports/tr24/ + Branch: perl + + lib/unicode/In/100.pl lib/unicode/In/101.pl + + lib/unicode/In/102.pl lib/unicode/In/103.pl + + lib/unicode/In/104.pl lib/unicode/In/105.pl + + lib/unicode/In/106.pl lib/unicode/In/107.pl + + lib/unicode/In/108.pl lib/unicode/In/109.pl + + lib/unicode/In/110.pl lib/unicode/In/111.pl + + lib/unicode/In/112.pl lib/unicode/In/113.pl + + lib/unicode/In/114.pl lib/unicode/In/115.pl + + lib/unicode/In/116.pl lib/unicode/In/117.pl + + lib/unicode/In/118.pl lib/unicode/In/119.pl + + lib/unicode/In/120.pl lib/unicode/In/121.pl + + lib/unicode/In/122.pl lib/unicode/In/123.pl + + lib/unicode/In/124.pl lib/unicode/In/125.pl + + lib/unicode/In/126.pl lib/unicode/In/127.pl + + lib/unicode/In/128.pl lib/unicode/In/129.pl + + lib/unicode/In/130.pl lib/unicode/In/131.pl + + lib/unicode/In/132.pl lib/unicode/In/133.pl + + lib/unicode/In/134.pl lib/unicode/In/135.pl + + lib/unicode/In/96.pl lib/unicode/In/97.pl lib/unicode/In/98.pl + + lib/unicode/In/99.pl lib/unicode/Scripts.pl + ! (edit 106 files) +____________________________________________________________________________ +[ 11131] By: jhi on 2001/07/03 23:02:02 + Log: Better document the difference between a block and a script. + Branch: perl + ! lib/Unicode/UCD.pm +____________________________________________________________________________ +[ 11130] By: jhi on 2001/07/03 22:49:15 + Log: Subject: [ perl 5.6.1 ] CPAN.pm doc patch + From: Elaine -HFB- Ashton + Date: Tue, 3 Jul 2001 15:04:23 -0500 + Message-ID: <20010703150423.C9787@chaos.wustl.edu> + Branch: perl + ! lib/CPAN.pm +____________________________________________________________________________ +[ 11129] By: jhi on 2001/07/03 22:45:41 + Log: Add tests for charscript(). + Branch: perl + ! lib/Unicode/UCD.pm lib/Unicode/UCD.t +____________________________________________________________________________ +[ 11128] By: jhi on 2001/07/03 20:41:54 + Log: Add charscript() to get the UTR#24 script names of characters. + Branch: perl + ! lib/Unicode/UCD.pm +____________________________________________________________________________ +[ 11127] By: jhi on 2001/07/03 19:53:29 + Log: Todo updates. + Branch: perl + ! pod/perltodo.pod +____________________________________________________________________________ +[ 11126] By: jhi on 2001/07/03 19:45:30 + Log: Unicode::UCD updates. + Branch: perl + ! lib/Unicode/UCD.pm +____________________________________________________________________________ +[ 11125] By: jhi on 2001/07/03 16:12:20 + Log: Subject: MakeMaker should pass through DEFINE and INC to subdirs + From: Alan Burlison + Date: Tue, 03 Jul 2001 15:20:13 +0100 + Message-ID: <3B41D49D.A923D4F9@sun.com> + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 11124] By: jhi on 2001/07/03 16:06:53 + Log: Subject: Patch needed for UTS + From: hom00@utsglobal.com (Hal Morris) + Date: Tue, 3 Jul 2001 09:38:22 -0700 (PDT) + Message-Id: <200107031638.JAA11998@cepheus.utsglobal.com> + + Replace #11113 with a better version. + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 11123] By: jhi on 2001/07/03 16:04:49 + Log: Subject: Re: POINTERRIGOR + From: Andy Dougherty + Date: Tue, 3 Jul 2001 11:49:28 -0400 (EDT) + Message-ID: + Branch: perl + ! util.c +____________________________________________________________________________ +[ 11122] By: jhi on 2001/07/03 16:03:31 + Log: Subject: Re: [PATCH @11016] Fixes compile errors in four files + From: "Philip Newton" + Date: Tue, 3 Jul 2001 17:03:34 +0200 + Message-ID: <3B41FAE6.29564.660E117@localhost> + Branch: perl + ! pp_hot.c +____________________________________________________________________________ +[ 11121] By: jhi on 2001/07/03 13:26:08 + Log: Typos. + Branch: perl + ! INSTALL +____________________________________________________________________________ +[ 11120] By: jhi on 2001/07/03 11:34:47 + Log: Subject: [PATCH 5.6.1] debugger fixes + From: Ilya Zakharevich + Date: Tue, 3 Jul 2001 03:38:18 -0400 + Message-ID: <20010703033818.A16788@math.ohio-state.edu> + + The $^S is working again. + Branch: perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 11119] By: jhi on 2001/07/03 11:33:27 + Log: Subject: Re: [PATCH 5.6.1] OS/2 improvements + From: Ilya Zakharevich + Date: Tue, 3 Jul 2001 03:34:06 -0400 + Message-ID: <20010703033406.A16776@math.ohio-state.edu> + Branch: perl + ! os2/OS2/Process/Process.pm +____________________________________________________________________________ +[ 11118] By: jhi on 2001/07/03 11:29:54 + Log: Subject: [PATCH bleadperl] Bad lishp in change 11084 + From: "Philip Newton" + Date: Tue, 3 Jul 2001 09:11:27 +0200 + Message-Id: <200107030706.KAA04596@taas.iki.fi> + Branch: perl + ! lib/FindBin.pm +____________________________________________________________________________ +[ 11117] By: jhi on 2001/07/03 11:25:14 + Log: Delta delta. + Branch: perl + ! pod/perl572delta.pod +____________________________________________________________________________ +[ 11116] By: jhi on 2001/07/02 23:06:50 + Log: Metaconfig unit change for 11115. + Branch: metaconfig + ! U/modified/libc.U +____________________________________________________________________________ +[ 11115] By: jhi on 2001/07/02 23:06:27 + Log: Whitespace allowed at the ends of /lib/syscalls.exp lines + (from Richard Hatch) (this was the cause of pipes() and + times() myeteriously not being found) + Branch: perl + ! Configure +____________________________________________________________________________ +[ 11114] By: jhi on 2001/07/02 22:58:41 + Log: Retract #10142, the real culprit found by Richard Hatch, + coming soon to Configure near you. + Branch: perl + ! hints/aix.sh +____________________________________________________________________________ +[ 11113] By: jhi on 2001/07/02 22:56:09 + Log: (Replaced by #11124) UTS workaround from Hal Morris. + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 11112] By: jhi on 2001/07/02 22:53:29 + Log: Subject: [PATCH] grok not grocking correctly + From: Nicholas Clark + Date: Tue, 3 Jul 2001 00:19:08 +0100 + Message-ID: <20010703001908.H59620@plum.flirble.org> + Branch: perl + ! numeric.c +____________________________________________________________________________ +[ 11111] By: jhi on 2001/07/02 22:48:42 + Log: Subject: [PATCH Deparse.t] test just-posted patches + From: Robin Houston + Date: Mon, 2 Jul 2001 23:46:15 +0100 + Message-Id: + Branch: perl + ! ext/B/Deparse.t +____________________________________________________________________________ +[ 11110] By: jhi on 2001/07/02 22:27:10 + Log: Subject: [PATCH toke.c] autosplit into @F + From: Robin Houston + Date: Mon, 2 Jul 2001 23:18:20 +0100 + Message-Id: + Branch: perl + ! perl.c toke.c +____________________________________________________________________________ +[ 11109] By: jhi on 2001/07/02 22:25:03 + Log: Subject: [PATCH B::Deparse] hash key auto-quoting + From: Robin Houston + Date: Mon, 2 Jul 2001 23:00:48 +0100 + Message-Id: + Branch: perl + ! ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 11108] By: jhi on 2001/07/02 19:21:18 + Log: Subject: Re: [PATCH perlsnap] '-' !~ /\w/ + From: "Philip Newton" + Date: Mon, 2 Jul 2001 22:06:22 +0200 + (no Message-Id) + Branch: perl + ! ext/NDBM_File/hints/linux.pl +____________________________________________________________________________ +[ 11107] By: jhi on 2001/07/02 19:19:25 + Log: Subject: Re: Fixed pack problem - sort of + From: Nicholas Clark + Date: Mon, 2 Jul 2001 20:59:20 +0100 + Message-ID: <20010702205919.F59620@plum.flirble.org> + Branch: perl + ! pp_pack.c t/op/pack.t +____________________________________________________________________________ +[ 11106] By: jhi on 2001/07/02 19:18:28 + Log: Subject: Re: [PATCH 5.6.1] OS/2 cwd + From: Ilya Zakharevich + Date: Mon, 2 Jul 2001 15:45:41 -0400 + Message-ID: <20010702154541.B24295@math.ohio-state.edu> + Branch: perl + ! os2/os2.c +____________________________________________________________________________ +[ 11105] By: jhi on 2001/07/02 19:17:27 + Log: (Mistaken retraction) + Branch: perl + ! utils/pl2pm.PL +____________________________________________________________________________ +[ 11104] By: jhi on 2001/07/02 18:56:15 + Log: Detypo in #11103. + Branch: perl + ! utils/pl2pm.PL +____________________________________________________________________________ +[ 11103] By: jhi on 2001/07/02 18:54:53 + Log: Subject: [PATCH 2 pl2pm.PL] (was Re: [PATCH pl2pm.PL] Make pl2pm be nice with 'strict' and 'warnings') + From: Jonathan Stowe + Date: Mon, 2 Jul 2001 19:17:21 +0100 (BST) + Message-ID: + Branch: perl + ! utils/pl2pm.PL +____________________________________________________________________________ +[ 11102] By: jhi on 2001/07/02 18:16:09 + Log: Subject: [PATCH perl@11059] UCD.pm: if at first you don't succeed, croak? + From: "Craig A. Berry" + Date: Mon, 02 Jul 2001 14:11:23 -0500 + Message-Id: <5.1.0.14.0.20010702140058.01b6c9c0@exchi01> + Branch: perl + ! lib/Unicode/UCD.pm +____________________________________________________________________________ +[ 11101] By: jhi on 2001/07/02 18:14:51 + Log: Subject: [PATCH] Re: op/numconvert.t failures + From: Nicholas Clark + Date: Mon, 2 Jul 2001 20:10:48 +0100 + Message-ID: <20010702201048.E59620@plum.flirble.org> + Branch: perl + ! t/op/numconvert.t +____________________________________________________________________________ +[ 11100] By: jhi on 2001/07/02 17:51:44 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 11099] By: jhi on 2001/07/02 17:46:31 + Log: Retract #11055, didn't help much (2736 bytes vs 2725 bytes leaked). + The real fix must be more involved. The line of code all the leaky + call stacks seem to go through is op.c:2949, the PmopSTASH_set() + line of Perl_newPMOP(). + Branch: perl + ! op.h +____________________________________________________________________________ +[ 11098] By: jhi on 2001/07/02 17:37:44 + Log: Based on + + Subject: Re: sizeof(struct sembuf) + From: Nicholas Clark + Date: Sun, 1 Jul 2001 22:26:48 +0100 + Message-ID: <20010701222648.W59620@plum.flirble.org> + + but do semop() always the slow way. + Branch: perl + ! doio.c +____________________________________________________________________________ +[ 11097] By: jhi on 2001/07/02 17:22:14 + Log: Subject: [PATCH] Encode/Tcl.t, for esc-seq encodings + From: SADAHIRO Tomoyuki + Date: Tue, 03 Jul 2001 00:56:30 +0900 + Message-Id: <20010703005600.2225.BQW10602@nifty.com> + Branch: perl + ! ext/Encode/Encode/Tcl.t +____________________________________________________________________________ +[ 11096] By: jhi on 2001/07/02 17:11:24 + Log: Subject: [PATCH] Encode/Tcl.pm, continuous sequences + From: SADAHIRO Tomoyuki + Date: Tue, 03 Jul 2001 00:55:46 +0900 + Message-Id: <20010703005516.2222.BQW10602@nifty.com> + Branch: perl + ! ext/Encode/Encode/Tcl.pm +____________________________________________________________________________ +[ 11095] By: jhi on 2001/07/02 17:07:14 + Log: Regen api and toc. + Branch: perl + ! pod/perlapi.pod pod/perltoc.pod +____________________________________________________________________________ +[ 11094] By: jhi on 2001/07/02 16:29:42 + Log: Metaconfig unit change for #11093. + Branch: metaconfig/U/perl + ! d_fcntl_can_lock.U +____________________________________________________________________________ +[ 11093] By: jhi on 2001/07/02 16:28:56 + Log: The fcntl locking test may hang if NFS locking messed up; + break out with alarm(10). + Branch: perl + ! Configure +____________________________________________________________________________ +[ 11092] By: jhi on 2001/07/02 14:11:31 + Log: Move the mdelete.bat from win32/bin to win32. + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 11091] By: jhi on 2001/07/02 14:10:01 + Log: Typo in #11083. + Branch: perl + ! ext/Time/Piece/Piece.t +____________________________________________________________________________ +[ 11090] By: jhi on 2001/07/02 13:36:58 + Log: Netware tweaks from Guruprasad. + Branch: perl + - NetWare/perlsdio.h + ! MANIFEST NetWare/Makefile NetWare/interface.c + ! NetWare/interface.h NetWare/iperlhost.h NetWare/nwtinfo.h + ! perlsdio.h +____________________________________________________________________________ +[ 11089] By: jhi on 2001/07/02 13:25:40 + Log: Subject: Re: [PATH] shared -> unique; + From: Abhijit Menon-Sen + Date: Wed, 27 Jun 2001 03:51:27 +0530 + Message-ID: <20010627035127.A17623@lustre.lustre.dyn.wiw.org> + Branch: perl + ! dump.c gv.c gv.h op.c pp_sys.c sv.c toke.c xsutils.c +____________________________________________________________________________ +[ 11088] By: jhi on 2001/07/02 13:24:27 + Log: Subject: Re: AIX / gcc-3.0 + From: "H.Merijn Brand" + Date: Mon, 02 Jul 2001 15:20:21 +0200 + Message-Id: <20010702151904.49BB.H.M.BRAND@hccnet.nl> + Branch: perl + ! hints/aix.sh +____________________________________________________________________________ +[ 11087] By: jhi on 2001/07/02 13:23:21 + Log: Subject: Re: Bug report: split splits on wrong pattern + From: Abhijit Menon-Sen + Message-ID: <20010702163133.A23186@lustre.dyn.wiw.org> + Date: Mon, 2 Jul 2001 16:31:33 +0530 + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 11086] By: jhi on 2001/07/02 13:22:30 + Log: Subject: [PATCH 5.6.1] test harness + From: Ilya Zakharevich + Date: Mon, 2 Jul 2001 06:29:21 -0400 + Message-ID: <20010702062921.A1810@math.ohio-state.edu> + Branch: perl + ! lib/Test/Harness.pm +____________________________________________________________________________ +[ 11085] By: jhi on 2001/07/02 13:21:39 + Log: Subject: [PATCH 5.6.1] debugger goof + From: Ilya Zakharevich + Date: Mon, 2 Jul 2001 06:27:22 -0400 + Message-ID: <20010702062722.A1746@math.ohio-state.edu> + Branch: perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 11084] By: jhi on 2001/07/02 13:20:50 + Log: Subject: [PATCH 5.6.1] OS/2 cwd + From: Ilya Zakharevich + Date: Mon, 2 Jul 2001 06:21:17 -0400 + Message-ID: <20010702062117.A1401@math.ohio-state.edu> + Branch: perl + ! lib/Cwd.pm lib/File/Find/taint.t lib/FindBin.pm os2/os2.c +____________________________________________________________________________ +[ 11083] By: jhi on 2001/07/02 13:19:18 + Log: Make #11082 more OS/2-specific. + Branch: perl + ! ext/Time/Piece/Piece.t +____________________________________________________________________________ +[ 11082] By: jhi on 2001/07/02 13:14:36 + Log: Subject: [PATCH 5.6.1] OS/2 gmtime() + From: Ilya Zakharevich + Date: Mon, 2 Jul 2001 06:06:34 -0400 + Message-ID: <20010702060634.A1356@math.ohio-state.edu> + Branch: perl + ! ext/Time/Piece/Piece.t +____________________________________________________________________________ +[ 11081] By: jhi on 2001/07/02 13:13:08 + Log: Subject: [PATCH B::Deparse] version number & changes + From: Robin Houston + Date: Sun, 1 Jul 2001 17:17:29 +0100 + Message-ID: <20010701171729.A30678@puffinry.freeserve.co.uk> + Branch: perl + ! ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 11080] By: jhi on 2001/07/02 13:11:48 + Log: Subject: a small fix. + From: "Konovalov, Vadim Vladimirovich (Vadim)" + Date: Mon, 2 Jul 2001 12:17:53 +0200 + Message-ID: + Branch: perl + ! ext/Thread/Thread.xs +____________________________________________________________________________ +[ 11079] By: jhi on 2001/07/02 13:10:39 + Log: Subject: RE: perl@10907 + From: "Konovalov, Vadim Vladimirovich (Vadim)" + Date: Mon, 2 Jul 2001 12:06:16 +0200 + Message-ID: + + Borland C vs PerlIO. + Branch: perl + ! win32/config.bc win32/config_H.bc +____________________________________________________________________________ +[ 11078] By: jhi on 2001/07/02 13:03:44 + Log: Subject: [PATCH] Report /pro/3gl/CPAN/perl-5.7.1 + From: "H.M. Brand" + Date: Mon, 02 Jul 2001 11:18:57 +0200 + Message-Id: <20010702100811.4999.MERIJN@l1.procura.nl> + Branch: perl + ! t/op/write.t +____________________________________________________________________________ +[ 11077] By: jhi on 2001/07/02 12:58:27 + Log: Subject: [PATCH] Deleting ext/util/mkbootstrap + From: Michael G Schwern + Date: Mon, 2 Jul 2001 00:26:24 -0400 + Message-ID: <20010702002624.A18302@blackrider> + Branch: perl + - ext/util/mkbootstrap +____________________________________________________________________________ +[ 11076] By: jhi on 2001/07/02 12:56:20 + Log: Subject: [PATCH op.h] v minor comment tweak + From: Robin Houston + Date: Mon, 2 Jul 2001 00:42:01 +0100 + Message-Id: + Branch: perl + ! op.h +____________________________________________________________________________ +[ 11075] By: jhi on 2001/07/02 12:53:48 + Log: SysV IPC semops use native shorts, not forced-to-16-bit-shorts. + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 11074] By: jhi on 2001/07/02 12:52:28 + Log: Subject: Re: sizeof(struct sembuf) + From: Nicholas Clark + Date: Sun, 1 Jul 2001 19:23:16 +0100 + Message-ID: <20010701192316.V59620@plum.flirble.org> + + s/signaling/signalling/ + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 11073] By: jhi on 2001/07/02 12:49:51 + Log: Subject: [PATCH perlsnap] Suggestion for mnemonic for $^N + From: "Philip Newton" + Date: Sun, 1 Jul 2001 09:37:56 +0200 + Message-Id: <200107010733.KAA03920@taas.iki.fi> + Branch: perl + ! pod/perlvar.pod +____________________________________________________________________________ +[ 11072] By: jhi on 2001/07/02 12:48:03 + Log: Subject: [PATCH perlsnap] /^qnx|nto$/ --> /^(?:qnx|nto)$/ + From: "Philip Newton" + Date: Sun, 1 Jul 2001 09:37:56 +0200 + Message-Id: <200107010733.KAA03925@taas.iki.fi> + Branch: perl + ! lib/ExtUtils/MM_Unix.pm lib/File/Spec/Unix.pm +____________________________________________________________________________ +[ 11071] By: jhi on 2001/07/02 12:45:12 + Log: Metaconfig unit change for #11070. + Branch: metaconfig + ! U/compline/randfunc.U +____________________________________________________________________________ +[ 11070] By: jhi on 2001/07/02 12:43:58 + Log: Subject: [PATCH perlsnap] its --> it's --> its + From: "Philip Newton" + Date: Sun, 1 Jul 2001 09:37:56 +0200 + Message-Id: <200107010733.KAA03914@taas.iki.fi> + Branch: perl + ! Porting/config_H +____________________________________________________________________________ +[ 11069] By: jhi on 2001/07/02 12:01:52 + Log: Sync with Sarathy; integrate with perlio. + Branch: perl + !> gv.c +____________________________________________________________________________ +[ 11068] By: gsar on 2001/07/02 08:07:54 + Log: regenerate win32/config_H.?c files + Branch: perl + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc +____________________________________________________________________________ +[ 11067] By: gsar on 2001/07/02 08:03:55 + Log: rename s/sv_getcwd/getcwd_sv/ for better conformance to existing + naming discipline + + win32 fix: enable getcwd_sv() to work on windows (POSIX.t was failing + because of this) + + fix a warning about "fd" being used without being set in Cwd.xs + Branch: perl + ! embed.h embed.pl ext/Cwd/Cwd.xs ext/POSIX/POSIX.t + ! ext/POSIX/POSIX.xs global.sym objXSUB.h perlapi.c + ! pod/perlapi.pod proto.h util.c win32/config.bc win32/config.gc + ! win32/config.vc +____________________________________________________________________________ +[ 11066] By: gsar on 2001/07/02 07:12:10 + Log: win32 fixes: fix various syntax errors ("no preprocessor directives + within macro arguments") and warnings ("unary minus applied to + unsigned type", among others) + Branch: perl + ! gv.c hv.c op.c pp.c sv.c toke.c +____________________________________________________________________________ +[ 11065] By: gsar on 2001/07/02 06:26:22 + Log: win32 fixes: more spurious CRs + Branch: perl + ! win32/mdelete.bat +____________________________________________________________________________ +[ 11064] By: gsar on 2001/07/02 06:25:22 + Log: win32 tweaks: remove extra CRs from makefile.mk; move mdelete.bat + from win32/bin (or it gets deleted by distclean); don't delete + lib/Cwd.pm during distclean; mdelete.bat doesn't work properly on + NT (should be made Win9x specific, and added to makefile.mk) + Branch: perl + +> win32/mdelete.bat + - win32/bin/mdelete.bat + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 11063] By: nick on 2001/07/01 18:54:09 + Log: Quick for for #ifdef mess + Branch: perlio + ! gv.c +____________________________________________________________________________ +[ 11062] By: nick on 2001/07/01 18:47:42 + Log: Raw integrate - does not build #if mess in gv.c + Branch: perlio + !> (integrate 29 files) +____________________________________________________________________________ +[ 11061] By: jhi on 2001/07/01 15:20:38 + Log: Make 'compile' target a little less broken. + Still very broken, though: -Wall warnings from + the generated code, boot_Foo prototypes missing, + can't autoload Fcntl::SEEK_CUR et alia, ... + Branch: perl + ! ext/B/B/C.pm pod/Makefile.SH t/TEST utils/Makefile + ! utils/perlcc.PL x2p/Makefile.SH +____________________________________________________________________________ +[ 11060] By: jhi on 2001/07/01 14:04:20 + Log: Upgrade to Storable 1.0.12, from Raphael Manfredi. + Branch: perl + ! ext/Storable/ChangeLog ext/Storable/Storable.pm + ! ext/Storable/Storable.xs ext/Storable/t/freeze.t +____________________________________________________________________________ +[ 11059] By: jhi on 2001/07/01 05:02:59 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ [ 11058] By: jhi on 2001/07/01 04:57:05 Log: Still one typo, regen toc. Branch: perl diff --git a/Configure b/Configure index f91462e..87547b0 100755 --- a/Configure +++ b/Configure @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Fri Jun 29 17:44:53 EET DST 2001 [metaconfig 3.0 PL70] +# Generated on Wed Jul 4 20:30:41 EET DST 2001 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.org) cat >c1$$ <&4 - $sed -n 's/^\([^ ]*\)[ ]*syscall[0-9]*$/\1/p' /lib/syscalls.exp >>libc.list + $sed -n 's/^\([^ ]*\)[ ]*syscall[0-9]*[ ]*$/\1/p' /lib/syscalls.exp >>libc.list fi ;; esac @@ -9860,10 +9860,12 @@ eval $inlibc echo " " : See if fcntl-based locking works. -$cat >try.c <<'EOCP' +$cat >try.c < #include #include +#include +$signal_t blech(x) int x; { exit(3); } int main() { #if defined(F_SETLK) && defined(F_SETLKW) struct flock flock; @@ -9872,6 +9874,8 @@ int main() { flock.l_type = F_RDLCK; flock.l_whence = SEEK_SET; flock.l_start = flock.l_len = 0; + signal(SIGALRM, blech); + alarm(10); retval = fcntl(fd, F_SETLK, &flock); close(fd); (retval < 0 ? exit(2) : exit(0)); @@ -9891,6 +9895,18 @@ case "$d_fcntl" in else echo "Nope, it didn't work." val="$undef" + case "$?" in + 3) $cat >&4 <s; mv -f s t/comp/cpp.aux sed -e $SARGV -e $SDOTTMP t/io/argv.t >s; mv -f s t/io/argv.t sed -e $SABC t/io/inplace.t >s; mv -f s t/io/inplace.t -sed -e $SDBMX t/lib/anydbm.t >s; mv -f s t/lib/anydbm.t -sed -e $SDBMX -e $SDBHASH t/lib/gdbm.t >s; mv -f s t/lib/gdbm.t -sed -e $SDBMX -e $SDBHASH t/lib/sdbm.t >s; mv -f s t/lib/sdbm.t +sed -e $SDBMX -e $SDBHASH ext/GDBM_File/gdbm.t >s; mv -f s ext/GDBM_File/gdbm.t sed -e $SSTAT -e $STMP2 t/op/stat.t >s; mv -f s t/op/stat.t sed -e $SLIST x2p/Makefile.SH |tr -d '\r' >s; mv -f s x2p/Makefile.SH sed -e 's=^#define.\([A-Z]\+\)_EXP.*$=#define \1_EXP djgpp_pathexp("\1")=g' config_h.SH >s; mv -f s config_h.SH diff --git a/doio.c b/doio.c index dfd8710..d0d28b0 100644 --- a/doio.c +++ b/doio.c @@ -2029,13 +2029,42 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp) id = SvIVx(*++mark); opstr = *++mark; opbuf = SvPV(opstr, opsize); - if (opsize < sizeof(struct sembuf) - || (opsize % sizeof(struct sembuf)) != 0) { + if (opsize < 3 * SHORTSIZE + || (opsize % (3 * SHORTSIZE))) { SETERRNO(EINVAL,LIB$_INVARG); return -1; } SETERRNO(0,0); - return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf)); + /* We can't assume that sizeof(struct sembuf) == 3 * sizeof(short). */ + { + int nsops = opsize / (3 * sizeof (short)); + int i = nsops; + short *ops = (short *) opbuf; + short *o = ops; + struct sembuf *temps, *t; + I32 result; + + New (0, temps, nsops, struct sembuf); + t = temps; + while (i--) { + t->sem_num = *o++; + t->sem_op = *o++; + t->sem_flg = *o++; + t++; + } + result = semop(id, temps, nsops); + t = temps; + o = ops; + i = nsops; + while (i--) { + *o++ = t->sem_num; + *o++ = t->sem_op; + *o++ = t->sem_flg; + t++; + } + Safefree(temps); + return result; + } #else Perl_croak(aTHX_ "semop not implemented"); #endif diff --git a/dump.c b/dump.c index 2a8fec6..1ec2a60 100644 --- a/dump.c +++ b/dump.c @@ -519,6 +519,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) else if (o->op_type == OP_CONST) { if (o->op_private & OPpCONST_BARE) sv_catpv(tmpsv, ",BARE"); + if (o->op_private & OPpCONST_OCTAL) + sv_catpv(tmpsv, ",OCTAL"); if (o->op_private & OPpCONST_STRICT) sv_catpv(tmpsv, ",STRICT"); if (o->op_private & OPpCONST_ARYBASE) @@ -960,7 +962,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo case SVt_PVGV: if (GvINTRO(sv)) sv_catpv(d, "INTRO,"); if (GvMULTI(sv)) sv_catpv(d, "MULTI,"); - if (GvSHARED(sv)) sv_catpv(d, "SHARED,"); + if (GvUNIQUE(sv)) sv_catpv(d, "UNIQUE,"); if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,"); if (GvIN_PAD(sv)) sv_catpv(d, "IN_PAD,"); if (flags & SVpad_OUR) sv_catpv(d, "OUR,"); diff --git a/embed.h b/embed.h index 42013a1..21bde98 100644 --- a/embed.h +++ b/embed.h @@ -671,7 +671,7 @@ #define sv_collxfrm Perl_sv_collxfrm #endif #define sv_compile_2op Perl_sv_compile_2op -#define sv_getcwd Perl_sv_getcwd +#define getcwd_sv Perl_getcwd_sv #define sv_dec Perl_sv_dec #define sv_dump Perl_sv_dump #define sv_derived_from Perl_sv_derived_from @@ -2178,7 +2178,7 @@ #define sv_collxfrm(a,b) Perl_sv_collxfrm(aTHX_ a,b) #endif #define sv_compile_2op(a,b,c,d) Perl_sv_compile_2op(aTHX_ a,b,c,d) -#define sv_getcwd(a) Perl_sv_getcwd(aTHX_ a) +#define getcwd_sv(a) Perl_getcwd_sv(aTHX_ a) #define sv_dec(a) Perl_sv_dec(aTHX_ a) #define sv_dump(a) Perl_sv_dump(aTHX_ a) #define sv_derived_from(a,b) Perl_sv_derived_from(aTHX_ a,b) @@ -3084,11 +3084,11 @@ # if defined(PERL_IMPLICIT_SYS) # endif #endif -#if defined(MYMALLOC) #define malloc Perl_malloc #define calloc Perl_calloc #define realloc Perl_realloc #define mfree Perl_mfree +#if defined(MYMALLOC) #define malloced_size Perl_malloced_size #endif #define get_context Perl_get_context @@ -4279,8 +4279,8 @@ #endif #define Perl_sv_compile_2op CPerlObj::Perl_sv_compile_2op #define sv_compile_2op Perl_sv_compile_2op -#define Perl_sv_getcwd CPerlObj::Perl_sv_getcwd -#define sv_getcwd Perl_sv_getcwd +#define Perl_getcwd_sv CPerlObj::Perl_getcwd_sv +#define getcwd_sv Perl_getcwd_sv #define Perl_sv_dec CPerlObj::Perl_sv_dec #define sv_dec Perl_sv_dec #define Perl_sv_dump CPerlObj::Perl_sv_dump diff --git a/embed.pl b/embed.pl index 9ad4767..e322ae2 100755 --- a/embed.pl +++ b/embed.pl @@ -1359,11 +1359,11 @@ Ajno |PerlInterpreter*|perl_clone_using|PerlInterpreter *interp|UV flags \ # endif #endif -#if defined(MYMALLOC) Ajnop |Malloc_t|malloc |MEM_SIZE nbytes Ajnop |Malloc_t|calloc |MEM_SIZE elements|MEM_SIZE size Ajnop |Malloc_t|realloc |Malloc_t where|MEM_SIZE nbytes Ajnop |Free_t |mfree |Malloc_t where +#if defined(MYMALLOC) jnp |MEM_SIZE|malloced_size |void *p #endif @@ -2031,7 +2031,7 @@ Apd |I32 |sv_cmp_locale |SV* sv1|SV* sv2 Apd |char* |sv_collxfrm |SV* sv|STRLEN* nxp #endif Ap |OP* |sv_compile_2op |SV* sv|OP** startp|char* code|AV** avp -Apd |int |sv_getcwd |SV* sv +Apd |int |getcwd_sv |SV* sv Apd |void |sv_dec |SV* sv Ap |void |sv_dump |SV* sv Apd |bool |sv_derived_from|SV* sv|const char* name diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index 1560420..08f073e 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -19,7 +19,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber cstring CVf_METHOD CVf_LOCKED CVf_LVALUE PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE PMf_SKIPWHITE PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED); -$VERSION = 0.60; +$VERSION = 0.61; use strict; use warnings (); @@ -92,6 +92,19 @@ use warnings (); # - separate recognition of constant subs # - rewrote continue block handling, now recoginizing for loops # - added more control of expanding control structures +# Changes between 0.60 and 0.61 (mostly by Robin Houston) +# - many bug-fixes +# - support for pragmas and 'use' +# - support for the little-used $[ variable +# - support for __DATA__ sections +# - UTF8 support +# - BEGIN, CHECK, INIT and END blocks +# - scoping of subroutine declarations fixed +# - compile-time output from the input program can be suppressed, so that the +# output is just the deparsed code. (a change to O.pm in fact) +# - our() declarations +# - *all* the known bugs are now listed in the BUGS section +# - comprehensive test mechanism (TEST -deparse) # Todo: # (See also BUGS section at the end of this file) @@ -483,9 +496,15 @@ sub new { return $self; } -sub WARN_MASK () { - # Mask out the bits that C uses - $warnings::Bits{all} | $warnings::DeadBits{all}; +{ + # Mask out the bits that L uses + my $WARN_MASK; + BEGIN { + $WARN_MASK = $warnings::Bits{all} | $warnings::DeadBits{all}; + } + sub WARN_MASK () { + return $WARN_MASK; + } } # Initialise the contextual information, either from @@ -613,7 +632,7 @@ sub ambient_pragmas { elsif ($name eq 'warnings') { if ($val eq 'none') { - $warning_bits = "\0"x12; + $warning_bits = $warnings::NONE; next(); } @@ -625,7 +644,7 @@ sub ambient_pragmas { @names = split/\s+/, $val; } - $warning_bits = "\0"x12 if !defined ($warning_bits); + $warning_bits = $warnings::NONE if !defined ($warning_bits); $warning_bits |= warnings::bits(@names); } @@ -1257,10 +1276,10 @@ sub pp_nextstate { my $warnings = $op->warnings; my $warning_bits; if ($warnings->isa("B::SPECIAL") && $$warnings == 4) { - $warning_bits = $warnings::Bits{"all"}; + $warning_bits = $warnings::Bits{"all"} & WARN_MASK; } elsif ($warnings->isa("B::SPECIAL") && $$warnings == 5) { - $warning_bits = "\0"x12; + $warning_bits = $warnings::NONE; } elsif ($warnings->isa("B::SPECIAL")) { $warning_bits = undef; @@ -2656,6 +2675,16 @@ sub elem { # $idx =~ s/^\((.*)\)$/$1/ if $self->{'parens'}; + # Hash-element braces will autoquote a bareword inside themselves. + # We need to make sure that C<$hash{warn()}> doesn't come out as + # C<$hash{warn}>, which has a quite different meaning. Currently + # B::Deparse will always quote strings, even if the string was a + # bareword in the original (i.e. the OPpCONST_BARE flag is ignored + # for constant strings.) So we can cheat slightly here - if we see + # a bareword, we know that it is supposed to be a function call. + # + $idx =~ s/^([A-Za-z_]\w*)$/$1()/; + return "\$" . $array . $left . $idx . $right; } @@ -4100,9 +4129,22 @@ than in the input file. =item * +In fact, the above is a specific instance of a more general problem: +we can't guarantee to produce BEGIN blocks or C declarations in +exactly the right place. So if you use a module which affects compilation +(such as by over-riding keywords, overloading constants or whatever) +then the output code might not work as intended. + +This is the most serious outstanding problem, and will be very hard +to fix. + +=item * + If a keyword is over-ridden, and your program explicitly calls the built-in version by using CORE::keyword, the output of B::Deparse -will not reflect this. +will not reflect this. If you run the resulting code, it will call +the over-ridden version rather than the built-in one. (Maybe there +should be an option to B print keyword calls as C.) =item * diff --git a/ext/B/Deparse.t b/ext/B/Deparse.t index 0979d7e..20cef75 100644 --- a/ext/B/Deparse.t +++ b/ext/B/Deparse.t @@ -15,7 +15,7 @@ use warnings; use strict; use Config; -print "1..14\n"; +print "1..15\n"; use B::Deparse; my $deparse = B::Deparse->new() or print "not "; @@ -105,7 +105,7 @@ $b = <<'EOF'; LINE: while (defined($_ = )) { chomp $_; - @F = split(" ", $_, 0); + our(@F) = split(" ", $_, 0); '???'; } @@ -114,27 +114,27 @@ print "# [$a]\n\# vs expected\n# [$b]\nnot " if $a ne $b; print "ok " . $i++ . "\n"; __DATA__ -# 1 +# 2 1; #### -# 2 +# 3 { no warnings; '???'; 2; } #### -# 3 +# 4 my $test; ++$test and $test /= 2; >>>> my $test; $test /= 2 if ++$test; #### -# 4 +# 5 -((1, 2) x 2); #### -# 5 +# 6 { my $test = sub : lvalue { my $x; @@ -142,7 +142,7 @@ $test /= 2 if ++$test; ; } #### -# 6 +# 7 { my $test = sub : method { my $x; @@ -150,7 +150,7 @@ $test /= 2 if ++$test; ; } #### -# 7 +# 8 { my $test = sub : locked method { my $x; @@ -158,7 +158,7 @@ $test /= 2 if ++$test; ; } #### -# 8 +# 9 { 234; } @@ -166,10 +166,14 @@ continue { 123; } #### -# 9 +# 10 my $x; print $main::x; #### -# 10 +# 11 my @x; print $main::x[1]; +#### +# 12 +my %x; +$x{warn()}; diff --git a/ext/Cwd/Cwd.xs b/ext/Cwd/Cwd.xs index be9427b..b6f27b8 100644 --- a/ext/Cwd/Cwd.xs +++ b/ext/Cwd/Cwd.xs @@ -194,7 +194,11 @@ err1: serrno = errno; #else (void)chdir(wd); #endif -err2: (void)close(fd); + +err2: +#ifdef HAS_FCHDIR + (void)close(fd); +#endif errno = serrno; return (NULL); #endif @@ -209,7 +213,7 @@ fastcwd() PPCODE: { dXSTARG; - sv_getcwd(TARG); + getcwd_sv(TARG); XSprePUSH; PUSHTARG; } diff --git a/ext/Encode/Encode/Tcl.pm b/ext/Encode/Encode/Tcl.pm index f862eef..84d107f 100644 --- a/ext/Encode/Encode/Tcl.pm +++ b/ext/Encode/Encode/Tcl.pm @@ -230,7 +230,7 @@ use Carp; sub read { my ($obj,$fh,$name) = @_; - my(%tbl, @esc, $enc); + my(%tbl, @seq, $enc, @esc); while (<$fh>) { my ($key,$val) = /^(\S+)\s+(.*)$/; @@ -238,13 +238,15 @@ sub read $val =~ s/\\x([0-9a-f]{2})/chr(hex($1))/ge; if($enc = Encode->getEncoding($key)){ $tbl{$val} = ref($enc) eq 'Encode::Tcl' ? $enc->loadEncoding : $enc; - push @esc, $val; + push @seq, $val; }else{ $obj->{$key} = $val; } + if($val =~ /^\e(.*)/){ push(@esc, quotemeta $1) } } - $obj->{'Ctl'} = \@esc; - $obj->{'Tbl'} = \%tbl; + $obj->{'Seq'} = \@seq; # escape sequences + $obj->{'Tbl'} = \%tbl; # encoding tables + $obj->{'Esc'} = join('|', @esc); # regex of sequences following ESC return $obj; } @@ -252,33 +254,41 @@ sub decode { my ($obj,$str,$chk) = @_; my $tbl = $obj->{'Tbl'}; - my $ctl = $obj->{'Ctl'}; + my $seq = $obj->{'Seq'}; + my $esc = $obj->{'Esc'}; my $ini = $obj->{'init'}; my $fin = $obj->{'final'}; - my $std = $ctl->[0]; + my $std = $seq->[0]; my $cur = $std; my $uni; while (length($str)){ my $uch = substr($str,0,1,''); if($uch eq "\e"){ - $str =~ s/^([\x20-\x2F]*[\x30-\x7E](?:\x1b[\x20-\x2F]*[\x30-\x7E])*)//; - my $esc = "\e$1"; - if($tbl->{$esc}){ $cur = $esc } - elsif($esc eq $ini || $esc eq $fin){ $cur = $std } - else{carp "unknown escape sequence" } + if($str =~ s/^($esc)//) + { + my $esc = "\e$1"; + $cur = $tbl->{$esc} ? $esc : + ($esc eq $ini || $esc eq $fin) ? $std : + $cur; + } + else + { + $str =~ s/^([\x20-\x2F]*[\x30-\x7E])//; + carp "unknown escape sequence: ESC $1"; + } next; } if($uch eq "\x0e" || $uch eq "\x0f"){ $cur = $uch and next; } - my $x; if(ref($tbl->{$cur}) eq 'Encode::XS'){ $uni .= $tbl->{$cur}->decode($uch); next; } - my $ch = ord($uch); + my $ch = ord($uch); my $rep = $tbl->{$cur}->{'Rep'}; my $touni = $tbl->{$cur}->{'ToUni'}; + my $x; if (&$rep($ch) eq 'C') { $x = $touni->[0][$ch]; @@ -303,10 +313,10 @@ sub encode { my ($obj,$uni,$chk) = @_; my $tbl = $obj->{'Tbl'}; - my $ctl = $obj->{'Ctl'}; + my $seq = $obj->{'Seq'}; my $ini = $obj->{'init'}; my $fin = $obj->{'final'}; - my $std = $ctl->[0]; + my $std = $seq->[0]; my $str = $ini; my $pre = $std; my $cur = $pre; @@ -318,11 +328,11 @@ sub encode : $tbl->{$pre}->{FmUni}->{$ch}; unless(defined $x){ - foreach my $esc (@$ctl){ - $x = ref($tbl->{$esc}) eq 'Encode::XS' - ? $tbl->{$esc}->encode($ch,1) - : $tbl->{$esc}->{FmUni}->{$ch}; - $cur = $esc and last if defined $x; + foreach my $e_seq (@$seq){ + $x = ref($tbl->{$e_seq}) eq 'Encode::XS' + ? $tbl->{$e_seq}->encode($ch,1) + : $tbl->{$e_seq}->{FmUni}->{$ch}; + $cur = $e_seq and last if defined $x; } } if($x == 0x0d && !($ini eq '' && $fin eq '') && substr($uni,0,1) eq "\x0a") diff --git a/ext/Encode/Encode/Tcl.t b/ext/Encode/Encode/Tcl.t index e26cf7c..5e5d8f9 100644 --- a/ext/Encode/Encode/Tcl.t +++ b/ext/Encode/Encode/Tcl.t @@ -41,7 +41,37 @@ my %ideodigit = ( # cjk ideograph 'one' to 'ten' ); my @ideodigit = qw(one two three four five six seven eight nine ten); -plan test => $n*@encodings + $n*@encodings*@greek + $n*@encodings*@ideodigit; +my $jis = '7bit-jis'; +my $kr = '7bit-kr'; +my %esc_str; + +$esc_str{$jis} = {qw( + 1b24422422242424262428242a1b2842 + 3042304430463048304a + 1b284931323334355d1b2842 + ff71ff72ff73ff74ff75ff9d + 1b2442467c4b5c1b2842 + 65e5672c + 3132331b244234413b7a1b28425065726c + 0031003200336f225b57005000650072006c + 546573740a1b24422546253925481b28420a + 0054006500730074000a30c630b930c8000a +)}; + +$esc_str{$kr} = {qw( + 1b2429430e2a22213e0f410d0a + 304200b10041000d000a + 1b2429430e3021332a34593673383639593b673e46405a0f0d0a + ac00b098b2e4b77cb9c8bc14c0acc544c790000d000a + 1b2429434142430d0a + 004100420043000d000a +)}; + +my $num_esc = $n * keys(%esc_str); +foreach (values %esc_str){ $num_esc += $n * keys %$_ } + +plan test => $n*@encodings + $n*@encodings*@greek + + $n*@encodings*@ideodigit + $num_esc; foreach my $enc (@encodings) { @@ -81,3 +111,35 @@ foreach my $enc (@encodings) } } +{ + sub to_unicode + { + my $enc = shift; + return unpack('H*', pack 'n*', unpack 'U*', + decode $enc, pack 'H*', join '', @_); + } + + sub from_unicode + { + my $enc = shift; + return unpack('H*', encode $enc, + pack 'U*', unpack 'n*', pack 'H*', join '', @_); + } + + foreach my $enc (sort keys %esc_str) + { + my $tab = Encode->getEncoding($enc); + ok(1,defined($tab),"Could not load $enc"); + my %strings = %{ $esc_str{$enc} }; + foreach my $estr (sort keys %strings) + { + my $ustr = to_unicode($enc, $estr); + ok($ustr, $strings{$estr}, + "$enc mangled translating to Unicode"); + ok(from_unicode($enc, $ustr), $estr, + "$enc mangled translating from Unicode"); + } + ok(to_unicode($enc, keys %strings), join('', values %strings), + "$enc mangled translating to Unicode"); + } +} diff --git a/ext/IO/lib/IO/t/io_sock.t b/ext/IO/lib/IO/t/io_sock.t index 1c9bcc7..6b241c5 100755 --- a/ext/IO/lib/IO/t/io_sock.t +++ b/ext/IO/lib/IO/t/io_sock.t @@ -205,9 +205,15 @@ if ($^O eq 'mpeix') { print "not " unless $server->blocking; print "ok 13\n"; -$server->blocking(0); -print "not " if $server->blocking; -print "ok 14\n"; +if ( $^O eq 'qnx' ) { + # QNX library bug: Can set non-blocking on socket, but + # cannot return that status. + print "ok 14 # skipped\n"; +} else { + $server->blocking(0); + print "not " if $server->blocking; + print "ok 14\n"; +} ### TEST 15 ### Set up some data to be transfered between the server and diff --git a/ext/NDBM_File/hints/linux.pl b/ext/NDBM_File/hints/linux.pl index 47f9d2c..405afa7 100644 --- a/ext/NDBM_File/hints/linux.pl +++ b/ext/NDBM_File/hints/linux.pl @@ -3,4 +3,4 @@ # (no null key support) # Jonathan Stowe use Config; -$self->{LIBS} = ['-lgdbm'] if $Config{libs} =~ /\b-lgdbm\b/; +$self->{LIBS} = ['-lgdbm'] if $Config{libs} =~ /(?:^|\s)-lgdbm(?:\s|$)/; diff --git a/ext/POSIX/POSIX.t b/ext/POSIX/POSIX.t index aae4cf3..87a2aea 100755 --- a/ext/POSIX/POSIX.t +++ b/ext/POSIX/POSIX.t @@ -79,7 +79,7 @@ if ($Is_MPE) { print &_POSIX_OPEN_MAX > $fds[1] ? "ok 12\n" : "not ok 12\n" } -print getcwd() =~ m#/t$# ? "ok 13\n" : "not ok 13\n"; +print getcwd() =~ m#[/\\]t$# ? "ok 13\n" : "not ok 13\n"; # Check string conversion functions. diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 6f27ea3..1bf8521 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -1751,7 +1751,7 @@ getcwd() PPCODE: { dXSTARG; - sv_getcwd(TARG); + getcwd_sv(TARG); XSprePUSH; PUSHTARG; } diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index b209d3b..4816efc 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -342,6 +342,7 @@ static Signal_t handle_thread_signal(int sig) { unsigned char c = (unsigned char) sig; + dTHX; /* * We're not really allowed to call fprintf in a signal handler * so don't be surprised if this isn't robust while debugging diff --git a/ext/Time/Piece/Piece.t b/ext/Time/Piece/Piece.t index c62e36d..f200696 100644 --- a/ext/Time/Piece/Piece.t +++ b/ext/Time/Piece/Piece.t @@ -82,11 +82,18 @@ print "ok 21\n"; # In GMT there should be no daylight savings ever. -print "not " unless $t->isdst == 0; -print "ok 22\n"; - -print "not " unless $t->daylight_savings == 0; -print "ok 23\n"; +my $dst = 0; +my $dst_mess = ''; +if ($^O eq 'os2') { + # OS/2 EMX bug + $dst = (CORE::gmtime(0))[8]; + $dst_mess = ' # skipped: gmtime(0) thinks DST gmtime 0 == -1'; +} +print "not " unless $t->isdst == $dst; +print "ok 22$dst_mess\n"; + +print "not " unless $t->daylight_savings == $dst; +print "ok 23$dst_mess\n"; print "not " unless $t->hms eq '12:34:56'; print "ok 24\n"; diff --git a/ext/util/make_ext b/ext/util/make_ext index 54caf7d..317dd5c 100644 --- a/ext/util/make_ext +++ b/ext/util/make_ext @@ -116,7 +116,7 @@ nonxs) makeargs=""; esac if test ! -f $makefile ; then - test -f Makefile.PL && ../$depth/miniperl -I../$depth/lib Makefile.PL INSTALLDIRS=perl $passthru + test -f Makefile.PL && ../$depth/miniperl -I../$depth/lib Makefile.PL INSTALLDIRS=perl PERL_CORE=1 $passthru fi if test ! -f $makefile ; then if test -f Makefile.SH; then diff --git a/ext/util/mkbootstrap b/ext/util/mkbootstrap deleted file mode 100644 index 6c3a7e1..0000000 --- a/ext/util/mkbootstrap +++ /dev/null @@ -1,5 +0,0 @@ -#!../../miniperl -w -I../../lib - -use ExtUtils::MakeMaker; -&mkbootstrap(join(" ",@ARGV)); -exit; diff --git a/global.sym b/global.sym index 50b6bd1..5301739 100644 --- a/global.sym +++ b/global.sym @@ -413,7 +413,7 @@ Perl_sv_cmp Perl_sv_cmp_locale Perl_sv_collxfrm Perl_sv_compile_2op -Perl_sv_getcwd +Perl_getcwd_sv Perl_sv_dec Perl_sv_dump Perl_sv_derived_from diff --git a/gv.c b/gv.c index 3ac5306..e4951a0 100644 --- a/gv.c +++ b/gv.c @@ -46,9 +46,9 @@ Perl_gv_IOadd(pTHX_ register GV *gv) if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) Perl_croak(aTHX_ "Bad symbol for filehandle"); if (!GvIOp(gv)) { -#ifdef GV_SHARED_CHECK - if (GvSHARED(gv)) { - Perl_croak(aTHX_ "Bad symbol for filehandle (GV is shared)"); +#ifdef GV_UNIQUE_CHECK + if (GvUNIQUE(gv)) { + Perl_croak(aTHX_ "Bad symbol for filehandle (GV is unique)"); } #endif GvIOp(gv) = newIO(); @@ -488,7 +488,7 @@ S_require_errno(pTHX_ GV *gv) { HV* stash = gv_stashpvn("Errno",5,FALSE); - if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) { + if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) { dSP; PUTBACK; ENTER; @@ -740,7 +740,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) gv_init(gv, stash, name, len, add & GV_ADDMULTI); gv_init_sv(gv, sv_type); - if (isALPHA(name[0]) && ! (isLEXWARN_on ? ckWARN(WARN_ONCE) + if (isALPHA(name[0]) && ! (isLEXWARN_on ? ckWARN(WARN_ONCE) : (PL_dowarn & G_WARN_ON ) ) ) GvMULTI_on(gv) ; @@ -1359,13 +1359,13 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) AMT *amtp=NULL, *oamtp=NULL; int off=0, off1, lr=0, assign=AMGf_assign & flags, notfound=0; int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0; +#ifdef DEBUGGING int fl=0; +#endif HV* stash=NULL; if (!(AMGf_noleft & flags) && SvAMAGIC(left) - && (mg = mg_find((SV*)( - stash= - SvSTASH(SvRV(left))), - PERL_MAGIC_overload_table)) + && (stash = SvSTASH(SvRV(left))) + && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table)) && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table : (CV **) NULL)) @@ -1373,7 +1373,9 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) || (assign && amtp->fallback > AMGfallNEVER && /* fallback to * usual method */ ( +#ifdef DEBUGGING fl = 1, +#endif cv = cvp[off=method])))) { lr = -1; /* Call method for left argument */ } else { @@ -1480,10 +1482,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } if (!cv) goto not_found; } else if (!(AMGf_noright & flags) && SvAMAGIC(right) - && (mg = mg_find((SV*)( - stash= - SvSTASH(SvRV(right))), - PERL_MAGIC_overload_table)) + && (stash = SvSTASH(SvRV(right))) + && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table)) && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (amtp = (AMT*)mg->mg_ptr)->table : (CV **) NULL)) @@ -1582,7 +1582,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) flags & AMGf_unary? "" : lr==1 ? " for right argument": " for left argument", flags & AMGf_unary? " for argument" : "", - HvNAME(stash), + stash ? HvNAME(stash) : "null", fl? ",\n\tassignment variant used": "") ); } #endif diff --git a/gv.h b/gv.h index 01764e3..428ab77 100644 --- a/gv.h +++ b/gv.h @@ -133,15 +133,15 @@ HV *GvHVn(); /* XXX: all GvFLAGS options are used, borrowing GvGPFLAGS for the moment */ -#define GVf_SHARED 0x0001 -#define GvSHARED(gv) (GvGP(gv) && (GvGPFLAGS(gv) & GVf_SHARED)) -#define GvSHARED_on(gv) (GvGPFLAGS(gv) |= GVf_SHARED) -#define GvSHARED_off(gv) (GvGPFLAGS(gv) &= ~GVf_SHARED) +#define GVf_UNIQUE 0x0001 +#define GvUNIQUE(gv) (GvGP(gv) && (GvGPFLAGS(gv) & GVf_UNIQUE)) +#define GvUNIQUE_on(gv) (GvGPFLAGS(gv) |= GVf_UNIQUE) +#define GvUNIQUE_off(gv) (GvGPFLAGS(gv) &= ~GVf_UNIQUE) #ifdef USE_ITHREADS -#define GV_SHARED_CHECK +#define GV_UNIQUE_CHECK #else -#undef GV_SHARED_CHECK +#undef GV_UNIQUE_CHECK #endif #define Nullgv Null(GV*) diff --git a/hints/aix.sh b/hints/aix.sh index b637391..10d5d64 100644 --- a/hints/aix.sh +++ b/hints/aix.sh @@ -351,11 +351,6 @@ EOM exit 1 ;; esac - # XXX In 64-bit AIX 5L (oslevel 5.1.0.0, ccversion 5.0.2.0) - # the Configure library symbol probe mysteriously finds all - # symbols but these two --jhi XXX - d_pipe='define' - d_times='define' ;; esac EOCBU @@ -474,8 +469,11 @@ EOCBU if test $usenativedlopen = 'true' then - ccflags="$ccflags -DUSE_NATIVE_DLOPEN" - ldflags="$ldflags -brtl" + ccflags="$ccflags -DUSE_NATIVE_DLOPEN" + case "$cc" in + *gcc*) ldflags="$ldflags -Wl,-brtl" ;; + *) ldflags="$ldflags -brtl" ;; + esac else # If the C++ libraries, libC and libC_r, are available we will prefer them # over the vanilla libc, because the libC contain loadAndInit() and diff --git a/hints/dos_djgpp.sh b/hints/dos_djgpp.sh index ebbd786..f46bed8 100644 --- a/hints/dos_djgpp.sh +++ b/hints/dos_djgpp.sh @@ -71,3 +71,5 @@ $define|true|[yY]*) ;; esac EOCBU + +useperlio='undef' diff --git a/hints/posix-bc.sh b/hints/posix-bc.sh index 8a4f289..f844525 100644 --- a/hints/posix-bc.sh +++ b/hints/posix-bc.sh @@ -21,10 +21,7 @@ esac # -D_XOPEN_SOURCE_EXTENDED alters system headers. # -DPERL_IGNORE_FPUSIG=SIGFPE # Prepend your favorites with Configure -Dccflags=your_favorites -case "$ccflags" in -'') ccflags='-K enum_long,llm_case_lower,llm_keep,no_integer_overflow -DPOSIX_BC -DUSE_PURE_BISON -D_XOPEN_SOURCE -D_XOPEN_SOURCE_EXTENDED -DPERL_IGNORE_FPUSIG=SIGFPE' ;; -*) ccflags='$ccflags -Kenum_long,llm_case_lower,llm_keep,no_integer_overflow -DPOSIX_BC -DUSE_PURE_BISON -D_XOPEN_SOURCE -D_XOPEN_SOURCE_EXTENDED -DPERL_IGNORE_FPUSIG=SIGFPE' ;; -esac +ccflags="$ccflags -Kenum_long,llm_case_lower,llm_keep,no_integer_overflow -DPOSIX_BC -DUSE_PURE_BISON -D_XOPEN_SOURCE_EXTENDED -DPERL_IGNORE_FPUSIG=SIGFPE" # ccdlflags have yet to be determined. #case "$ccdlflags" in diff --git a/hints/qnx.sh b/hints/qnx.sh index 24199c9..a90ac37 100644 --- a/hints/qnx.sh +++ b/hints/qnx.sh @@ -50,12 +50,11 @@ # PATH. The PATH test is triggered because cwd calls # `fullpath -t`. # -# lib/ExtUtils.t: If you follow these hints and include -# -w4 in your ccflags, this test will complain about -# extra .err files appearing in its test directory. -# -# ext/IO/lib/IO/t/io_sock.t Still investigating -# ext/POSIX/sigaction.t Still investigating +# ext/IO/lib/IO/t/io_sock.t: Subtest 14 is skipped due to +# the fact that the functionality to read back the non-blocking +# status of a socket is not implemented in QNX's TCP/IP. This +# has been reported to QNX and it may work with later versions +# of TCP/IP. # # Older issues: # lib/posix.t test failed on test 17 because acos(1) != 0. diff --git a/hv.c b/hv.c index 48cb2cc..76180f2 100644 --- a/hv.c +++ b/hv.c @@ -441,7 +441,7 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 has #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv, PERL_MAGIC_env)) { key = savepvn(key,klen); - key = strupr(key); + key = (const char*)strupr((char*)key); hash = 0; } #endif @@ -598,9 +598,9 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash) entry = new_HE(); if (HvSHAREKEYS(hv)) - HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash); + HeKEY_hek(entry) = share_hek(key, is_utf8?-(I32)klen:klen, hash); else /* gotta do the real thing */ - HeKEY_hek(entry) = save_hek(key, is_utf8?-klen:klen, hash); + HeKEY_hek(entry) = save_hek(key, is_utf8?-(I32)klen:klen, hash); if (key != keysave) Safefree(key); HeVAL(entry) = val; diff --git a/lib/CPAN.pm b/lib/CPAN.pm index 817e970..5ee7dc8 100644 --- a/lib/CPAN.pm +++ b/lib/CPAN.pm @@ -4418,7 +4418,7 @@ or } else { $self->{writemakefile} = qq{NO Makefile.PL refused to write a Makefile.}; - # It's probably worth to record the reason, so let's retry + # It's probably worth it to record the reason, so let's retry # local $/; # my $fh = IO::File->new("$system |"); # STDERR? STDIN? # $self->{writemakefile} .= <$fh>; @@ -6064,10 +6064,11 @@ separated): Modules know their associated Distribution objects. They always refer to the most recent official release. Developers may mark their releases as unstable development versions (by inserting an underbar into the -visible version number), so the really hottest and newest distribution -file is not always the default. If a module Foo circulates on CPAN in -both version 1.23 and 1.23_90, CPAN.pm offers a convenient way to -install version 1.23 by saying +module version number which will also be reflected in the distribution +name when you run 'make dist'), so the really hottest and newest +distribution is not always the default. If a module Foo circulates +on CPAN in both version 1.23 and 1.23_90, CPAN.pm offers a convenient +way to install version 1.23 by saying install Foo diff --git a/lib/Cwd.pm b/lib/Cwd.pm index 27a3105..7192665 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -85,6 +85,25 @@ use base qw/ Exporter /; our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd); our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath); +# sys_cwd may keep the builtin command + +# All the functionality of this module may provided by builtins, +# there is no sense to process the rest of the file. +# The best choice may be to have this in BEGIN, but how to return from BEGIN? + +if ($^O eq 'os2' && defined &sys_cwd && defined &sys_abspath) { + local $^W = 0; + *cwd = \&sys_cwd; + *getcwd = \&cwd; + *fastgetcwd = \&cwd; + *fastcwd = \&cwd; + *abs_path = \&sys_abspath; + *fast_abs_path = \&abs_path; + *realpath = \&abs_path; + *fast_realpath = \&abs_path; + return 1; +} + eval { require XSLoader; XSLoader::load('Cwd'); @@ -315,7 +334,7 @@ sub _epoc_cwd { *fastcwd = \&_dos_cwd; *abs_path = \&fast_abs_path; } - elsif ($^O eq 'qnx') { + elsif ($^O =~ m/^(?:qnx|nto)$/ ) { *cwd = \&_qnx_cwd; *getcwd = \&_qnx_cwd; *fastgetcwd = \&_qnx_cwd; diff --git a/lib/ExtUtils.t b/lib/ExtUtils.t index 2ade74d..3c76657 100644 --- a/lib/ExtUtils.t +++ b/lib/ExtUtils.t @@ -371,7 +371,7 @@ close FH or die "close $makefilePL: $!\n"; chdir $dir or die $!; push @INC, '../../lib'; END {chdir ".." or warn $!}; -my @perlout = `$runperl Makefile.PL`; +my @perlout = `$runperl Makefile.PL PERL_CORE=1`; if ($?) { print "not ok 1 # $runperl Makefile.PL failed: $?\n"; print "# $_" foreach @perlout; diff --git a/lib/ExtUtils/MM_NW5.pm b/lib/ExtUtils/MM_NW5.pm index dc691e9..70dafe8 100644 --- a/lib/ExtUtils/MM_NW5.pm +++ b/lib/ExtUtils/MM_NW5.pm @@ -280,7 +280,8 @@ sub constants { INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC - PERL_INC PERL FULLPERL LIBPTH BASE_IMPORT + PERL_INC PERL FULLPERL LIBPTH BASE_IMPORT PERLRUN + PERLRUNINST TEST_LIBS FULL_AR PERL_CORE NLM_VERSION MPKTOOL TOOLPATH / ) { diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index 5e06b16..da6a032 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -84,7 +84,7 @@ sub canonpath { # Handle POSIX-style node names beginning with double slash my $node = ''; - if ( $^O =~ m/^qnx|nto$/ && $path =~ s:^(//[^/]+)(/|\z):/:s ) { + if ( $^O =~ m/^(?:qnx|nto)$/ && $path =~ s:^(//[^/]+)(/|\z):/:s ) { $node = $1; } $path =~ s|(?<=[^/])/+|/|g ; # xx////xx -> xx/xx @@ -464,6 +464,13 @@ EOT } my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files + if ( $^O eq 'qnx' ) { + my @errfiles = @{$self->{C}}; + for ( @errfiles ) { + s/.c$/.err/; + } + push( @otherfiles, @errfiles, 'perlmain.err' ); + } push(@otherfiles, $attribs{FILES}) if $attribs{FILES}; push(@otherfiles, qw[./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all perlmain.c tmon.out mon.out core core.*perl.*.? @@ -568,7 +575,8 @@ sub constants { INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC - PERL_INC PERL FULLPERL FULL_AR + PERL_INC PERL FULLPERL PERLRUN PERLRUNINST TEST_LIBS + FULL_AR PERL_CORE / ) { next unless defined $self->{$tmp}; @@ -841,19 +849,19 @@ distclean :: realclean distcheck push @m, q{ distcheck : - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=fullcheck \\ + $(PERLRUN) -MExtUtils::Manifest=fullcheck \\ -e fullcheck }; push @m, q{ skipcheck : - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=skipcheck \\ + $(PERLRUN) -MExtUtils::Manifest=skipcheck \\ -e skipcheck }; push @m, q{ manifest : - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=mkmanifest \\ + $(PERLRUN) -MExtUtils::Manifest=mkmanifest \\ -e mkmanifest }; @@ -875,7 +883,7 @@ sub dist_ci { my @m; push @m, q{ ci : - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \\ + $(PERLRUN) -MExtUtils::Manifest=maniread \\ -e "@all = keys %{ maniread() };" \\ -e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \\ -e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");' @@ -942,7 +950,7 @@ sub dist_dir { push @m, q{ distdir : $(RM_RF) $(DISTVNAME) - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=manicopy,maniread \\ + $(PERLRUN) -MExtUtils::Manifest=manicopy,maniread \\ -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" }; join "", @m; @@ -961,7 +969,7 @@ sub dist_test { my @m; push @m, q{ disttest : distdir - cd $(DISTVNAME) && $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) Makefile.PL + cd $(DISTVNAME) && $(PERLRUN) Makefile.PL cd $(DISTVNAME) && $(MAKE) cd $(DISTVNAME) && $(MAKE) test }; @@ -997,7 +1005,7 @@ static :: $self->{BASEEXT}.exp push(@m," $self->{BASEEXT}.exp: Makefile.PL -",' $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\ +",' $(PERLRUN) -e \'use ExtUtils::Mksymlists; \\ Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ', neatvalue($funcs), ', "FUNCLIST" => ', neatvalue($funclist), ', "DL_VARS" => ', neatvalue($vars), ');\' @@ -1045,7 +1053,7 @@ BOOTSTRAP = '."$self->{BASEEXT}.bs".' # The DynaLoader only reads a non-empty file. $(BOOTSTRAP): '."$self->{MAKEFILE} $self->{BOOTDEP}".' $(INST_ARCHAUTODIR)/.exists '.$self->{NOECHO}.'echo "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))" - '.$self->{NOECHO}.'$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \ + '.$self->{NOECHO}.'$(PERLRUN) \ -MExtUtils::Mkbootstrap \ -e "Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');" '.$self->{NOECHO}.'$(TOUCH) $(BOOTSTRAP) @@ -1400,7 +1408,7 @@ q[-e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "], $self->{MAKEFILE}, q[";' \\ -e 'print "Htmlifying $$m{$$_}\n";' \\ -e '$$dir = dirname($$m{$$_}); mkpath($$dir) unless -d $$dir;' \\ --e 'system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2HTML_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\\047t install $$m{$$_}\n";' \\ +-e 'system(q[$(PERLRUN) $(POD2HTML_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\\047t install $$m{$$_}\n";' \\ -e 'chmod(oct($(PERM_RW))), $$m{$$_} or warn "chmod $(PERM_RW) $$m{$$_}: $$!\n";}' ]; push @m, "\nhtmlifypods : pure_all "; @@ -2043,6 +2051,25 @@ usually solves this kind of problem. # Define 'FULLPERL' to be a non-miniperl (used in test: target) ($self->{FULLPERL} = $self->{PERL}) =~ s/miniperl/perl/i unless ($self->{FULLPERL}); + + # Are we building the core? + $self->{PERL_CORE} = 0 unless exists $self->{PERL_CORE}; + + # How do we run perl? + $self->{PERLRUN} = $self->{PERL}; + + # How do we run perl when installing libraries? + $self->{PERLRUNINST} .= $self->{PERL}. ' -I$(INST_ARCHLIB) -I$(INST_LIB)'; + + # What extra library dirs do we need when running the tests? + $self->{TEST_LIBS} .= ' -I$(INST_ARCHLIB) -I$(INST_LIB)'; + + # When building the core, we need to add some helper libs since + # perl's @INC won't work (we're not installed yet). + foreach my $targ (qw(PERLRUN PERLRUNINST TEST_LIBS)) { + $self->{$targ} .= ' -I$(PERL_ARCHLIB) -I$(PERL_LIB)' + if $self->{PERL_CORE}; + } } =item init_others @@ -2238,9 +2265,9 @@ sub installbin { EXE_FILES = @{$self->{EXE_FILES}} } . ($Is_Win32 - ? q{FIXIN = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ + ? q{FIXIN = $(PERLRUN) \ -e "system qq[pl2bat.bat ].shift" -} : q{FIXIN = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::MakeMaker \ +} : q{FIXIN = $(PERLRUN) -MExtUtils::MakeMaker \ -e "MY->fixin(shift)" }).qq{ pure_all :: @to @@ -2365,7 +2392,7 @@ $(MAP_TARGET) :: static $(MAKE_APERL_FILE) $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) }.$self->{NOECHO}.q{echo Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) - }.$self->{NOECHO}.q{$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ + }.$self->{NOECHO}.q{$(PERLRUNINST) \ Makefile.PL DIR=}, $dir, q{ \ MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=}; @@ -2601,7 +2628,7 @@ $(OBJECT) : $(FIRST_MAKEFILE) -}.$self->{NOECHO}.q{$(RM_F) }."$self->{MAKEFILE}.old".q{ -}.$self->{NOECHO}.q{$(MV) }."$self->{MAKEFILE} $self->{MAKEFILE}.old".q{ -$(MAKE) -f }.$self->{MAKEFILE}.q{.old clean $(DEV_NULL) || $(NOOP) - $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL }.join(" ",map(qq["$_"],@ARGV)).q{ + $(PERLRUN) Makefile.PL }.join(" ",map(qq["$_"],@ARGV)).q{ }.$self->{NOECHO}.q{echo "==> Your Makefile has been rebuilt. <==" }.$self->{NOECHO}.q{echo "==> Please rerun the make command. <==" false @@ -2654,7 +2681,7 @@ qq[POD2MAN = \$(PERL) -we '%m=\@ARGV;for (keys %m){' \\\n], q[-e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "], $self->{MAKEFILE}, q[";' \\ -e 'print "Manifying $$m{$$_}\n";' \\ --e 'system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\\047t install $$m{$$_}\n";' \\ +-e 'system(q[$(PERLRUN) $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\\047t install $$m{$$_}\n";' \\ -e 'chmod(oct($(PERM_RW))), $$m{$$_} or warn "chmod $(PERM_RW) $$m{$$_}: $$!\n";}' ]; push @m, "\nmanifypods : pure_all "; @@ -3061,8 +3088,7 @@ sub pm_to_blib { my($autodir) = $self->catdir('$(INST_LIB)','auto'); return q{ pm_to_blib: $(TO_INST_PM) - }.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \ - "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \ + }.$self->{NOECHO}.q{$(PERLRUNINST) -MExtUtils::Install \ -e "pm_to_blib({qw{$(PM_TO_BLIB)}},'}.$autodir.q{','$(PM_FILTER)')" }.$self->{NOECHO}.q{$(TOUCH) $@ }; @@ -3142,7 +3168,7 @@ all :: $target $self->{NOECHO}\$(NOOP) $target :: $plfile - \$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile $target + \$(PERLRUNINST) $plfile $target "; } } @@ -3462,7 +3488,7 @@ Helper method to write the test targets sub test_via_harness { my($self, $perl, $tests) = @_; $perl = "PERL_DL_NONLAZY=1 $perl" unless $Is_Win32; - "\t$perl".q! -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' !."$tests\n"; + "\t$perl".q! $(TEST_LIBS) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' !."$tests\n"; } =item test_via_script (o) @@ -3474,7 +3500,7 @@ Other helper method for test. sub test_via_script { my($self, $perl, $script) = @_; $perl = "PERL_DL_NONLAZY=1 $perl" unless $Is_Win32; - qq{\t$perl}.q{ -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) }.qq{$script + qq{\t$perl}.q{ $(TEST_LIBS) }.qq{$script }; } @@ -3493,7 +3519,7 @@ sub tool_autosplit { $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN}; q{ # Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto -AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e 'use AutoSplit;}.$asl.q{autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;' +AUTOSPLITFILE = $(PERLRUN) -e 'use AutoSplit;}.$asl.q{autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;' }; } @@ -3520,13 +3546,13 @@ SHELL = $bin_sh push @m, q{ # The following is a portable way to say mkdir -p # To see which directories are created, change the if 0 to if 1 -MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath +MKPATH = $(PERLRUN) -MExtUtils::Command -e mkpath # This helps us to minimize the effect of the .exists files A yet # better solution would be to have a stable file in the perl # distribution with a timestamp of zero. But this solution doesn't # need any changes to the core distribution and works with older perls -EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime +EQUALIZE_TIMESTAMP = $(PERLRUN) -MExtUtils::Command -e eqtime }; @@ -3759,7 +3785,7 @@ help: push @m, q{ Version_check: - }.$self->{NOECHO}.q{$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ + }.$self->{NOECHO}.q{$(PERLRUN) \ -MExtUtils::MakeMaker=Version_check \ -e "Version_check('$(MM_VERSION)')" }; @@ -3793,7 +3819,7 @@ sub xs_c { return '' unless $self->needs_linking(); ' .xs.c: - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c + $(PERLRUN) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c '; } @@ -3808,7 +3834,7 @@ sub xs_cpp { return '' unless $self->needs_linking(); ' .xs.cpp: - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.cpp + $(PERLRUN) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.cpp '; } @@ -3824,7 +3850,7 @@ sub xs_o { # many makes are too dumb to use xs_c then c_o return '' unless $self->needs_linking(); ' .xs$(OBJ_EXT): - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c + $(PERLRUN) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c '; } diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm index 816074a..41a11bb 100644 --- a/lib/ExtUtils/MM_VMS.pm +++ b/lib/ExtUtils/MM_VMS.pm @@ -538,7 +538,8 @@ sub constants { INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC PERL_VMS - PERL_INC PERL FULLPERL + PERL_INC PERL FULLPERL PERLRUN PERLRUNINST TEST_LIBS + FULL_AR PERL_CORE / ) { next unless defined $self->{$macro}; push @m, "$macro = $self->{$macro}\n"; diff --git a/lib/ExtUtils/MM_Win32.pm b/lib/ExtUtils/MM_Win32.pm index 7bcf1f1..be00a6b 100644 --- a/lib/ExtUtils/MM_Win32.pm +++ b/lib/ExtUtils/MM_Win32.pm @@ -254,7 +254,8 @@ sub constants { INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC - PERL_INC PERL FULLPERL + PERL_INC PERL FULLPERL PERLRUN PERLRUNINST TEST_LIBS + FULL_AR PERL_CORE / ) { next unless defined $self->{$tmp}; diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index 4e258ce..cef46bc 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -205,13 +205,13 @@ sub full_setup { LINKTYPE MAKEAPERL MAKEFILE MAN1PODS MAN3PODS MAP_TARGET MYEXTLIB PERL_MALLOC_OK NAME NEEDS_LINKING NOECHO NORECURS NO_VC OBJECT OPTIMIZE PERL PERLMAINCC - PERL_ARCHLIB PERL_LIB PERL_SRC PERM_RW PERM_RWX + PERLRUN PERLRUNINST PERL_ARCHLIB PERL_CORE + PERL_LIB PERL_SRC PERM_RW PERM_RWX PL_FILES PM PM_FILTER PMLIBDIRS POLLUTE PPM_INSTALL_EXEC - PPM_INSTALL_SCRIPT PREFIX - PREREQ_PM SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG + PPM_INSTALL_SCRIPT PREFIX + PREREQ_PM SKIP TEST_LIBS TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG XS_VERSION clean depend dist dynamic_lib linkext macro realclean tool_autosplit - MACPERL_SRC MACPERL_LIB MACLIBS_68K MACLIBS_PPC MACLIBS_SC MACLIBS_MRC MACLIBS_ALL_68K MACLIBS_ALL_PPC MACLIBS_SHARED /; @@ -411,7 +411,7 @@ sub ExtUtils::MakeMaker::new { } if ($self->{PARENT}) { $self->{PARENT}->{CHILDREN}->{$newclass} = $self; - foreach my $opt (qw(CAPI POLLUTE)) { + foreach my $opt (qw(CAPI POLLUTE PERL_CORE)) { if (exists $self->{PARENT}->{$opt} and not exists $self->{$opt}) { @@ -1060,7 +1060,7 @@ is built. You can invoke the corresponding section of the makefile with make perl That produces a new perl binary in the current directory with all -extensions linked in that can be found in INST_ARCHLIB , SITELIBEXP, +extensions linked in that can be found in INST_ARCHLIB, SITELIBEXP, and PERL_ARCHLIB. To do that, MakeMaker writes a new Makefile, on UNIX, this is called Makefile.aperl (may be system dependent). If you want to force the creation of a new perl, it is recommended, that you @@ -1591,6 +1591,11 @@ passed to subdirectory makes. Perl binary for tasks that can be done by miniperl +=item PERL_CORE + +Set only when MakeMaker is building the extensions of the Perl core +distribution. + =item PERLMAINCC The call to the program that is able to compile perlmain.c. Defaults @@ -1598,12 +1603,20 @@ to $(CC). =item PERL_ARCHLIB -Same as below, but for architecture dependent files. +Same as for PERL_LIB, but for architecture dependent files. + +Used only when MakeMaker is building the extensions of the Perl core +distribution (because normally $(PERL_ARCHLIB) is automatically in @INC, +and adding it would get in the way of PERL5LIB). =item PERL_LIB Directory containing the Perl library to use. +Used only when MakeMaker is building the extensions of the Perl core +distribution (because normally $(PERL_LIB) is automatically in @INC, +and adding it would get in the way of PERL5LIB). + =item PERL_MALLOC_OK defaults to 0. Should be set to TRUE if the extension can work with @@ -1632,6 +1645,17 @@ nullifies many advantages of Perl's malloc(), such as better usage of system resources, error detection, memory usage reporting, catchable failure of memory allocations, etc. +=item PERLRUN + +Use this instead of $(PERL) or $(FULLPERL) when you wish to run perl. +It will set up extra necessary flags for you. + +=item PERLRUNINST + +Use this instead of $(PERL) or $(FULLPERL) when you wish to run +perl to work with modules. It will add things like -I$(INST_ARCH) +and other necessary flags. + =item PERL_SRC Directory containing the Perl source code (use of this should be @@ -1744,11 +1768,16 @@ only check if any version is installed already. =item SKIP -Arryref. E.g. [qw(name1 name2)] skip (do not write) sections of the +Arrayref. E.g. [qw(name1 name2)] skip (do not write) sections of the Makefile. Caution! Do not use the SKIP attribute for the negligible speedup. It may seriously damage the resulting Makefile. Only use it if you really need it. +=item TEST_LIBS + +The set of -I's necessary to run a "make test". Use as: +$(PERL) $(TEST_LIBS) -e '...' for example. + =item TYPEMAPS Ref to array of typemap file names. Use this when the typemaps are diff --git a/lib/File/Find/taint.t b/lib/File/Find/taint.t index f640ef7..e4a292b 100644 --- a/lib/File/Find/taint.t +++ b/lib/File/Find/taint.t @@ -44,7 +44,7 @@ use File::Spec; use Cwd; -my $NonTaintedCwd = $^O eq 'MSWin32' || $^O eq 'cygwin'; +my $NonTaintedCwd = $^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'os2'; cleanup(); diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm index bd4d77b..00899e7 100644 --- a/lib/File/Spec/Unix.pm +++ b/lib/File/Spec/Unix.pm @@ -37,7 +37,7 @@ sub canonpath { # Handle POSIX-style node names beginning with double slash my $node = ''; - if ( $^O =~ m/^qnx|nto$/ && $path =~ s:^(//[^/]+)(/|\z):/:s ) { + if ( $^O =~ m/^(?:qnx|nto)$/ && $path =~ s:^(//[^/]+)(/|\z):/:s ) { $node = $1; } $path =~ s|/+|/|g unless($^O eq 'cygwin'); # xx////xx -> xx/xx diff --git a/lib/FindBin.pm b/lib/FindBin.pm index 5d4c575..c1b782c 100644 --- a/lib/FindBin.pm +++ b/lib/FindBin.pm @@ -107,15 +107,15 @@ BEGIN } else { - my $IsWin32 = $^O eq 'MSWin32'; - unless(($script =~ m#/# || ($IsWin32 && $script =~ m#\\#)) + my $dosish = ($^O eq 'MSWin32' or $^O eq 'os2'); + unless(($script =~ m#/# || ($dosish && $script =~ m#\\#)) && -f $script) { my $dir; foreach $dir (File::Spec->path) { my $scr = File::Spec->catfile($dir, $script); - if(-r $scr && (!$IsWin32 || -x _)) + if(-r $scr && (!$dosish || -x _)) { $script = $scr; diff --git a/lib/Net/DummyInetd.pm b/lib/Net/DummyInetd.pm deleted file mode 100644 index 2ffddf7..0000000 --- a/lib/Net/DummyInetd.pm +++ /dev/null @@ -1,148 +0,0 @@ -# Net::DummyInetd.pm -# -# Copyright (c) 1995-1997 Graham Barr . All rights reserved. -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. - -package Net::DummyInetd; - -require 5.002; - -use IO::Handle; -use IO::Socket; -use strict; -use vars qw($VERSION); -use Carp; - -$VERSION = do { my @r=(q$Revision: 1.6 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r}; - - -sub _process -{ - my $listen = shift; - my @cmd = @_; - my $vec = ''; - my $r; - - vec($vec,fileno($listen),1) = 1; - - while(select($r=$vec,undef,undef,undef)) - { - my $sock = $listen->accept; - my $pid; - - if($pid = fork()) - { - sleep 1; - close($sock); - } - elsif(defined $pid) - { - my $x = IO::Handle->new_from_fd($sock,"r"); - open(STDIN,"<&=".fileno($x)) || die "$! $@"; - close($x); - - my $y = IO::Handle->new_from_fd($sock,"w"); - open(STDOUT,">&=".fileno($y)) || die "$! $@"; - close($y); - - close($sock); - exec(@cmd) || carp "$! $@"; - } - else - { - close($sock); - carp $!; - } - } - exit -1; -} - -sub new -{ - my $self = shift; - my $type = ref($self) || $self; - - my $listen = IO::Socket::INET->new(Listen => 5, Proto => 'tcp'); - my $pid; - - return bless [ $listen->sockport, $pid ] - if($pid = fork()); - - _process($listen,@_); -} - -sub port -{ - my $self = shift; - $self->[0]; -} - -sub DESTROY -{ - my $self = shift; - kill 9, $self->[1]; -} - -1; - -__END__ - -=head1 NAME - -Net::DummyInetd - A dummy Inetd server - -=head1 SYNOPSIS - - use Net::DummyInetd; - use Net::SMTP; - - $inetd = new Net::DummyInetd qw(/usr/lib/sendmail -ba -bs); - - $smtp = Net::SMTP->new('localhost', Port => $inetd->port); - -=head1 DESCRIPTION - -C is just what its name says, it is a dummy inetd server. -Creation of a C will cause a child process to be spawned off -which will listen to a socket. When a connection arrives on this socket -the specified command is fork'd and exec'd with STDIN and STDOUT file -descriptors duplicated to the new socket. - -This package was added as an example of how to use C to connect -to a C process, which is not the default, via SIDIN and STDOUT. -A C package will be available in the next release of C - -=head1 CONSTRUCTOR - -=over 4 - -=item new ( CMD ) - -Creates a new object and spawns a child process which listens to a socket. -C is a list, which will be passed to C when a new process needs -to be created. - -=back - -=head1 METHODS - -=over 4 - -=item port - -Returns the port number on which the I object is listening - -=back - -=head1 AUTHOR - -Graham Barr - -=head1 COPYRIGHT - -Copyright (c) 1995-1997 Graham Barr. All rights reserved. -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut diff --git a/lib/Net/PH.pm b/lib/Net/PH.pm deleted file mode 100644 index d245b5c..0000000 --- a/lib/Net/PH.pm +++ /dev/null @@ -1,784 +0,0 @@ -# -# Copyright (c) 1995-1997 Graham Barr and -# Alex Hristov . All rights reserved. This program is free -# software; you can redistribute it and/or modify it under the same terms -# as Perl itself. - -package Net::PH; - -require 5.001; - -use strict; -use vars qw(@ISA $VERSION); -use Carp; - -use Socket 1.3; -use IO::Socket; -use Net::Cmd; -use Net::Config; - -$VERSION = "2.20"; # $Id: //depot/libnet/Net/PH.pm#7$ -@ISA = qw(Exporter Net::Cmd IO::Socket::INET); - -sub new -{ - my $pkg = shift; - my $host = shift if @_ % 2; - my %arg = @_; - my $hosts = defined $host ? [ $host ] : $NetConfig{ph_hosts}; - my $ph; - - my $h; - foreach $h (@{$hosts}) - { - $ph = $pkg->SUPER::new(PeerAddr => ($host = $h), - PeerPort => $arg{Port} || 'csnet-ns(105)', - Proto => 'tcp', - Timeout => defined $arg{Timeout} - ? $arg{Timeout} - : 120 - ) and last; - } - - return undef - unless defined $ph; - - ${*$ph}{'net_ph_host'} = $host; - - $ph->autoflush(1); - - $ph->debug(exists $arg{Debug} ? $arg{Debug} : undef); - - $ph; -} - -sub status -{ - my $ph = shift; - - $ph->command('status')->response; - $ph->code; -} - -sub login -{ - my $ph = shift; - my($user,$pass,$encrypted) = @_; - my $resp; - - $resp = $ph->command("login",$user)->response; - - if(defined($pass) && $resp == CMD_MORE) - { - if($encrypted) - { - my $challenge_str = $ph->message; - chomp($challenge_str); - Net::PH::crypt::crypt_start($pass); - my $cryptstr = Net::PH::crypt::encryptit($challenge_str); - - $ph->command("answer", $cryptstr); - } - else - { - $ph->command("clear", $pass); - } - $resp = $ph->response; - } - - $resp == CMD_OK; -} - -sub logout -{ - my $ph = shift; - - $ph->command("logout")->response == CMD_OK; -} - -sub id -{ - my $ph = shift; - my $id = @_ ? shift : $<; - - $ph->command("id",$id)->response == CMD_OK; -} - -sub siteinfo -{ - my $ph = shift; - - $ph->command("siteinfo"); - - my $ln; - my %resp; - my $cur_num = 0; - - while(defined($ln = $ph->getline)) - { - $ph->debug_print(0,$ln) - if ($ph->debug & 2); - chomp($ln); - my($code,$num,$tag,$data); - - if($ln =~ /^-(\d+):(\d+):(?:\s*([^:]+):)?\s*(.*)/o) - { - ($code,$num,$tag,$data) = ($1, $2, $3 || "",$4); - $resp{$tag} = bless [$code, $num, $tag, $data], "Net::PH::Result"; - } - else - { - $ph->set_status($ph->parse_response($ln)); - return \%resp; - } - } - - return undef; -} - -sub query -{ - my $ph = shift; - my $search = shift; - - my($k,$v); - - my @args = ('query', _arg_hash($search)); - - push(@args,'return',_arg_list( shift )) - if @_; - - unless($ph->command(@args)->response == CMD_INFO) - { - return $ph->code == 501 - ? [] - : undef; - } - - my $ln; - my @resp; - my $cur_num = 0; - - my($last_tag); - - while(defined($ln = $ph->getline)) - { - $ph->debug_print(0,$ln) - if ($ph->debug & 2); - chomp($ln); - my($code,$idx,$num,$tag,$data); - - if($ln =~ /^-(\d+):(\d+):\s*([^:]*):\s*(.*)/o) - { - ($code,$idx,$tag,$data) = ($1,$2,$3,$4); - my $num = $idx - 1; - - $resp[$num] ||= {}; - - $tag = $last_tag - unless(length($tag)); - - $last_tag = $tag; - - if(exists($resp[$num]->{$tag})) - { - $resp[$num]->{$tag}->[3] .= "\n" . $data; - } - else - { - $resp[$num]->{$tag} = bless [$code, $idx, $tag, $data], "Net::PH::Result"; - } - } - else - { - $ph->set_status($ph->parse_response($ln)); - return \@resp; - } - } - - return undef; -} - -sub change -{ - my $ph = shift; - my $search = shift; - my $make = shift; - - $ph->command( - "change", _arg_hash($search), - "make", _arg_hash($make) - )->response == CMD_OK; -} - -sub _arg_hash -{ - my $hash = shift; - - return $hash - unless(ref($hash)); - - my($k,$v); - my @r; - - while(($k,$v) = each %$hash) - { - my $a = $v; - $a =~ s/\n/\\n/sog; - $a =~ s/\t/\\t/sog; - $a = '"' . $a . '"' - if $a =~ /\W/; - $a = '""' - unless length $a; - - push(@r, "$k=$a"); - } - join(" ", @r); -} - -sub _arg_list -{ - my $arr = shift; - - return $arr - unless(ref($arr)); - - my $v; - my @r; - - foreach $v (@$arr) - { - my $a = $v; - $a =~ s/\n/\\n/sog; - $a =~ s/\t/\\t/sog; - $a = '"' . $a . '"' - if $a =~ /\W/; - push(@r, $a); - } - - join(" ",@r); -} - -sub add -{ - my $ph = shift; - my $arg = @_ > 1 ? { @_ } : shift; - - $ph->command('add', _arg_hash($arg))->response == CMD_OK; -} - -sub delete -{ - my $ph = shift; - my $arg = @_ > 1 ? { @_ } : shift; - - $ph->command('delete', _arg_hash($arg))->response == CMD_OK; -} - -sub force -{ - my $ph = shift; - my $search = shift; - my $force = shift; - - $ph->command( - "change", _arg_hash($search), - "force", _arg_hash($force) - )->response == CMD_OK; -} - - -sub fields -{ - my $ph = shift; - - $ph->command("fields", _arg_list(\@_)); - - my $ln; - my %resp; - my $cur_num = 0; - my @tags = (); - - while(defined($ln = $ph->getline)) - { - $ph->debug_print(0,$ln) - if ($ph->debug & 2); - chomp($ln); - - my($code,$num,$tag,$data,$last_tag); - - if($ln =~ /^-(\d+):(\d+):\s*([^:]*):\s*(.*)/o) - { - ($code,$num,$tag,$data) = ($1,$2,$3,$4); - - $tag = $last_tag - unless(length($tag)); - - $last_tag = $tag; - - if(exists $resp{$tag}) - { - $resp{$tag}->[3] .= "\n" . $data; - } - else - { - $resp{$tag} = bless [$code, $num, $tag, $data], "Net::PH::Result"; - push @tags, $tag; - } - } - else - { - $ph->set_status($ph->parse_response($ln)); - return wantarray ? (\%resp, \@tags) : \%resp; - } - } - - return; -} - -sub quit -{ - my $ph = shift; - - $ph->close - if $ph->command("quit")->response == CMD_OK; -} - -## -## Net::Cmd overrides -## - -sub parse_response -{ - return () - unless $_[1] =~ s/^(-?)(\d\d\d):?//o; - ($2, $1 eq "-"); -} - -sub debug_text { $_[2] =~ /^(clear)/i ? "$1 ....\n" : $_[2]; } - -package Net::PH::Result; - -sub code { shift->[0] } -sub value { shift->[1] } -sub field { shift->[2] } -sub text { shift->[3] } - -package Net::PH::crypt; - -# The code in this package is based upon 'cryptit.c', Copyright (C) 1988 by -# Steven Dorner, and Paul Pomes, and the University of Illinois Board -# of Trustees, and by CSNET. - -use integer; -use strict; - -sub ROTORSZ () { 256 } -sub MASK () { 255 } - -my(@t1,@t2,@t3,$n1,$n2); - -sub crypt_start { - my $pass = shift; - $n1 = 0; - $n2 = 0; - crypt_init($pass); -} - -sub crypt_init { - my $pw = shift; - my $i; - - @t2 = @t3 = (0) x ROTORSZ; - - my $buf = crypt($pw,$pw); - return -1 unless length($buf) > 0; - $buf = substr($buf . "\0" x 13,0,13); - my @buf = map { ord $_ } split(//, $buf); - - - my $seed = 123; - for($i = 0 ; $i < 13 ; $i++) { - $seed = $seed * $buf[$i] + $i; - } - @t1 = (0 .. ROTORSZ-1); - - for($i = 0 ; $i < ROTORSZ ; $i++) { - $seed = 5 * $seed + $buf[$i % 13]; - my $random = $seed % 65521; - my $k = ROTORSZ - 1 - $i; - my $ic = ($random & MASK) % ($k + 1); - $random >>= 8; - @t1[$k,$ic] = @t1[$ic,$k]; - next if $t3[$k] != 0; - $ic = ($random & MASK) % $k; - while($t3[$ic] != 0) { - $ic = ($ic + 1) % $k; - } - $t3[$k] = $ic; - $t3[$ic] = $k; - } - for($i = 0 ; $i < ROTORSZ ; $i++) { - $t2[$t1[$i] & MASK] = $i - } -} - -sub encode { - my $sp = shift; - my $ch; - my $n = scalar(@$sp); - my @out = ($n); - my $i; - - for($i = 0 ; $i < $n ; ) { - my($f0,$f1,$f2) = splice(@$sp,0,3); - push(@out, - $f0 >> 2, - ($f0 << 4) & 060 | ($f1 >> 4) & 017, - ($f1 << 2) & 074 | ($f2 >> 6) & 03, - $f2 & 077); - $i += 3; - } - join("", map { chr((($_ & 077) + 35) & 0xff) } @out); # ord('#') == 35 -} - -sub encryptit { - my $from = shift; - my @from = map { ord $_ } split(//, $from); - my @sp = (); - my $ch; - while(defined($ch = shift @from)) { - push(@sp, - $t2[($t3[($t1[($ch + $n1) & MASK] + $n2) & MASK] - $n2) & MASK] - $n1); - - $n1++; - if($n1 == ROTORSZ) { - $n1 = 0; - $n2++; - $n2 = 0 if $n2 == ROTORSZ; - } - } - encode(\@sp); -} - -1; - -__END__ - -=head1 NAME - -Net::PH - CCSO Nameserver Client class - -=head1 SYNOPSIS - - use Net::PH; - - $ph = Net::PH->new("some.host.name", - Port => 105, - Timeout => 120, - Debug => 0); - - if($ph) { - $q = $ph->query({ field1 => "value1" }, - [qw(name address pobox)]); - - if($q) { - } - } - - # Alternative syntax - - if($ph) { - $q = $ph->query('field1=value1', - 'name address pobox'); - - if($q) { - } - } - -=head1 DESCRIPTION - -C is a class implementing a simple Nameserver/PH client in Perl -as described in the CCSO Nameserver -- Server-Client Protocol. Like other -modules in the Net:: family the C object inherits methods from -C. - -=head1 CONSTRUCTOR - -=over 4 - -=item new ( [ HOST ] [, OPTIONS ]) - - $ph = Net::PH->new("some.host.name", - Port => 105, - Timeout => 120, - Debug => 0 - ); - -This is the constructor for a new Net::PH object. C is the -name of the remote host to which a PH connection is required. - -If C is not given, then the C specified in C -will be used. - -C is an optional list of named options which are passed in -a hash like fashion, using key and value pairs. Possible options are:- - -B - Port number to connect to on remote host. - -B - Maximum time, in seconds, to wait for a response from the -Nameserver, a value of zero will cause all IO operations to block. -(default: 120) - -B - Enable the printing of debugging information to STDERR - -=back - -=head1 METHODS - -Unless otherwise stated all methods return either a I or I -value, with I meaning that the operation was a success. When a method -states that it returns a value, failure will be returned as I or an -empty list. - -=over 4 - -=item query( SEARCH [, RETURN ] ) - - $q = $ph->query({ name => $myname }, - [qw(name email schedule)]); - - foreach $handle (@{$q}) { - foreach $field (keys %{$handle}) { - $c = ${$handle}{$field}->code; - $v = ${$handle}{$field}->value; - $f = ${$handle}{$field}->field; - $t = ${$handle}{$field}->text; - print "field:[$field] [$c][$v][$f][$t]\n" ; - } - } - - - -Search the database and return fields from all matching entries. - -The C argument is a reference to a HASH which contains field/value -pairs which will be passed to the Nameserver as the search criteria. - -C is optional, but if given it should be a reference to a list which -contains field names to be returned. - -The alternative syntax is to pass strings instead of references, for example - - $q = $ph->query('name=myname', - 'name email schedule'); - -The C argument is a string that is passed to the Nameserver as the -search criteria. The strings being passed should B contain any carriage -returns, or else the query command might fail or return invalid data. - -C is optional, but if given it should be a string which will -contain field names to be returned. - -Each match from the server will be returned as a HASH where the keys are the -field names and the values are C objects (I, I, -I, I). - -Returns a reference to an ARRAY which contains references to HASHs, one -per match from the server. - -=item change( SEARCH , MAKE ) - - $r = $ph->change({ email => "*.domain.name" }, - { schedule => "busy"); - -Change field values for matching entries. - -The C argument is a reference to a HASH which contains field/value -pairs which will be passed to the Nameserver as the search criteria. - -The C argument is a reference to a HASH which contains field/value -pairs which will be passed to the Nameserver that -will set new values to designated fields. - -The alternative syntax is to pass strings instead of references, for example - - $r = $ph->change('email="*.domain.name"', - 'schedule="busy"'); - -The C argument is a string to be passed to the Nameserver as the -search criteria. The strings being passed should B contain any carriage -returns, or else the query command might fail or return invalid data. - - -The C argument is a string to be passed to the Nameserver that -will set new values to designated fields. - -Upon success all entries that match the search criteria will have -the field values, given in the Make argument, changed. - -=item login( USER, PASS [, ENCRYPT ]) - - $r = $ph->login('username','password',1); - -Enter login mode using C and C. If C is given and -is I then the password will be used to encrypt a challenge text -string provided by the server, and the encrypted string will be sent back -to the server. If C is not given, or I then the password -will be sent in clear text (I) - -=item logout() - - $r = $ph->logout(); - -Exit login mode and return to anonymous mode. - -=item fields( [ FIELD_LIST ] ) - - $fields = $ph->fields(); - foreach $field (keys %{$fields}) { - $c = ${$fields}{$field}->code; - $v = ${$fields}{$field}->value; - $f = ${$fields}{$field}->field; - $t = ${$fields}{$field}->text; - print "field:[$field] [$c][$v][$f][$t]\n"; - } - -In a scalar context, returns a reference to a HASH. The keys of the HASH are -the field names and the values are C objects (I, -I, I, I). - -In an array context, returns a two element array. The first element is a -reference to a HASH as above, the second element is a reference to an array -which contains the tag names in the order that they were returned from the -server. - -C is a string that lists the fields for which info will be -returned. - -=item add( FIELD_VALUES ) - - $r = $ph->add( { name => $name, phone => $phone }); - -This method is used to add new entries to the Nameserver database. You -must successfully call L before this method can be used. - -B that this method adds new entries to the database. To modify -an existing entry use L. - -C is a reference to a HASH which contains field/value -pairs which will be passed to the Nameserver and will be used to -initialize the new entry. - -The alternative syntax is to pass a string instead of a reference, for example - - $r = $ph->add('name=myname phone=myphone'); - -C is a string that consists of field/value pairs which the -new entry will contain. The strings being passed should B contain any -carriage returns, or else the query command might fail or return invalid data. - - -=item delete( FIELD_VALUES ) - - $r = $ph->delete('name=myname phone=myphone'); - -This method is used to delete existing entries from the Nameserver database. -You must successfully call L before this method can be used. - -B that this method deletes entries to the database. To modify -an existing entry use L. - -C is a string that serves as the search criteria for the -records to be deleted. Any entry in the database which matches this search -criteria will be deleted. - -=item id( [ ID ] ) - - $r = $ph->id('709'); - -Sends C to the Nameserver, which will enter this into its -logs. If C is not given then the UID of the user running the -process will be sent. - -=item status() - -Returns the current status of the Nameserver. - -=item siteinfo() - - $siteinfo = $ph->siteinfo(); - foreach $field (keys %{$siteinfo}) { - $c = ${$siteinfo}{$field}->code; - $v = ${$siteinfo}{$field}->value; - $f = ${$siteinfo}{$field}->field; - $t = ${$siteinfo}{$field}->text; - print "field:[$field] [$c][$v][$f][$t]\n"; - } - -Returns a reference to a HASH containing information about the server's -site. The keys of the HASH are the field names and values are -C objects (I, I, I, I). - -=item quit() - - $r = $ph->quit(); - -Quit the connection - -=back - -=head1 Q&A - -How do I get the values of a Net::PH::Result object? - - foreach $handle (@{$q}) { - foreach $field (keys %{$handle}) { - $my_code = ${$q}{$field}->code; - $my_value = ${$q}{$field}->value; - $my_field = ${$q}{$field}->field; - $my_text = ${$q}{$field}->text; - } - } - -How do I get a count of the returned matches to my query? - - $my_count = scalar(@{$query_result}); - -How do I get the status code and message of the last C<$ph> command? - - $status_code = $ph->code; - $status_message = $ph->message; - -=head1 SEE ALSO - -L - -=head1 AUTHORS - -Graham Barr -Alex Hristov - -=head1 ACKNOWLEDGMENTS - -Password encryption code ported to perl by Broc Seib , -Purdue University Computing Center. - -Otis Gospodnetic suggested -passing parameters as string constants. Some queries cannot be -executed when passing parameters as string references. - - Example: query first_name last_name email="*.domain" - -=head1 COPYRIGHT - -The encryption code is based upon cryptit.c, Copyright (C) 1988 by -Steven Dorner, and Paul Pomes, and the University of Illinois Board -of Trustees, and by CSNET. - -All other code is Copyright (c) 1996-1997 Graham Barr -and Alex Hristov . All rights reserved. This program is -free software; you can redistribute it and/or modify it under the same -terms as Perl itself. - -=cut diff --git a/lib/Net/SNPP.pm b/lib/Net/SNPP.pm deleted file mode 100644 index 60781b3..0000000 --- a/lib/Net/SNPP.pm +++ /dev/null @@ -1,414 +0,0 @@ -# Net::SNPP.pm -# -# Copyright (c) 1995-1997 Graham Barr . All rights reserved. -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. - -package Net::SNPP; - -require 5.001; - -use strict; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); -use Socket 1.3; -use Carp; -use IO::Socket; -use Net::Cmd; -use Net::Config; - -$VERSION = "1.11"; # $Id:$ -@ISA = qw(Net::Cmd IO::Socket::INET); -@EXPORT = (qw(CMD_2WAYERROR CMD_2WAYOK CMD_2WAYQUEUED), @Net::Cmd::EXPORT); - -sub CMD_2WAYERROR () { 7 } -sub CMD_2WAYOK () { 8 } -sub CMD_2WAYQUEUED () { 9 } - -sub new -{ - my $self = shift; - my $type = ref($self) || $self; - my $host = shift if @_ % 2; - my %arg = @_; - my $hosts = defined $host ? [ $host ] : $NetConfig{snpp_hosts}; - my $obj; - - my $h; - foreach $h (@{$hosts}) - { - $obj = $type->SUPER::new(PeerAddr => ($host = $h), - PeerPort => $arg{Port} || 'snpp(444)', - Proto => 'tcp', - Timeout => defined $arg{Timeout} - ? $arg{Timeout} - : 120 - ) and last; - } - - return undef - unless defined $obj; - - ${*$obj}{'net_snpp_host'} = $host; - - $obj->autoflush(1); - - $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef); - - unless ($obj->response() == CMD_OK) - { - $obj->close(); - return undef; - } - - $obj; -} - -## -## User interface methods -## - -sub pager_id -{ - @_ == 2 or croak 'usage: $snpp->pager_id( PAGER_ID )'; - shift->_PAGE(@_); -} - -sub content -{ - @_ == 2 or croak 'usage: $snpp->content( MESSAGE )'; - shift->_MESS(@_); -} - -sub send -{ - my $me = shift; - - if(@_) - { - my %arg = @_; - - if(exists $arg{Pager}) - { - my $pagers = ref($arg{Pager}) ? $arg{Pager} : [ $arg{Pager} ]; - my $pager; - foreach $pager (@$pagers) - { - $me->_PAGE($pager) || return 0 - } - } - - $me->_MESS($arg{Message}) || return 0 - if(exists $arg{Message}); - - $me->hold($arg{Hold}) || return 0 - if(exists $arg{Hold}); - - $me->hold($arg{HoldLocal},1) || return 0 - if(exists $arg{HoldLocal}); - - $me->_COVE($arg{Coverage}) || return 0 - if(exists $arg{Coverage}); - - $me->_ALER($arg{Alert} ? 1 : 0) || return 0 - if(exists $arg{Alert}); - - $me->service_level($arg{ServiceLevel}) || return 0 - if(exists $arg{ServiceLevel}); - } - - $me->_SEND(); -} - -sub data -{ - my $me = shift; - - my $ok = $me->_DATA() && $me->datasend(@_); - - return $ok - unless($ok && @_); - - $me->dataend; -} - -sub login -{ - @_ == 2 || @_ == 3 or croak 'usage: $snpp->login( USER [, PASSWORD ])'; - shift->_LOGI(@_); -} - -sub help -{ - @_ == 1 or croak 'usage: $snpp->help()'; - my $me = shift; - - return $me->_HELP() ? $me->message - : undef; -} - -sub xwho -{ - @_ == 1 or croak 'usage: $snpp->xwho()'; - my $me = shift; - - $me->_XWHO or return undef; - - my(%hash,$line); - my @msg = $me->message; - pop @msg; # Remove command complete line - - foreach $line (@msg) { - $line =~ /^\s*(\S+)\s*(.*)/ and $hash{$1} = $2; - } - - \%hash; -} - -sub service_level -{ - @_ == 2 or croak 'usage: $snpp->service_level( LEVEL )'; - my $me = shift; - my $level = int(shift); - - if($level < 0 || $level > 11) - { - $me->set_status(550,"Invalid Service Level"); - return 0; - } - - $me->_LEVE($level); -} - -sub alert -{ - @_ == 1 || @_ == 2 or croak 'usage: $snpp->alert( VALUE )'; - my $me = shift; - my $value = (@_ == 1 || shift) ? 1 : 0; - - $me->_ALER($value); -} - -sub coverage -{ - @_ == 1 or croak 'usage: $snpp->coverage( AREA )'; - shift->_COVE(@_); -} - -sub hold -{ - @_ == 2 || @_ == 3 or croak 'usage: $snpp->hold( TIME [, LOCAL ] )'; - my $me = shift; - my $time = shift; - my $local = (shift) ? "" : " +0000"; - - my @g = reverse((gmtime($time))[0..5]); - $g[1] += 1; - $g[0] %= 100; - - $me->_HOLD( sprintf("%02d%02d%02d%02d%02d%02d%s",@g,$local)); -} - -sub caller_id -{ - @_ == 2 or croak 'usage: $snpp->caller_id( CALLER_ID )'; - shift->_CALL(@_); -} - -sub subject -{ - @_ == 2 or croak 'usage: $snpp->subject( SUBJECT )'; - shift->_SUBJ(@_); -} - -sub two_way -{ - @_ == 1 or croak 'usage: $snpp->two_way()'; - shift->_2WAY(); -} - -sub quit -{ - @_ == 1 or croak 'usage: $snpp->quit()'; - my $snpp = shift; - - $snpp->_QUIT; - $snpp->close; -} - -## -## IO/perl methods -## - -sub DESTROY -{ - my $snpp = shift; - defined(fileno($snpp)) && $snpp->quit -} - -## -## Over-ride methods (Net::Cmd) -## - -sub debug_text -{ - $_[2] =~ s/^((logi|page)\s+\S+\s+)\S+/$1 xxxx/io; - $_[2]; -} - -sub parse_response -{ - return () - unless $_[1] =~ s/^(\d\d\d)(.?)//o; - my($code,$more) = ($1, $2 eq "-"); - - $more ||= $code == 214; - - ($code,$more); -} - -## -## RFC1861 commands -## - -# Level 1 - -sub _PAGE { shift->command("PAGE", @_)->response() == CMD_OK } -sub _MESS { shift->command("MESS", @_)->response() == CMD_OK } -sub _RESE { shift->command("RESE")->response() == CMD_OK } -sub _SEND { shift->command("SEND")->response() == CMD_OK } -sub _QUIT { shift->command("QUIT")->response() == CMD_OK } -sub _HELP { shift->command("HELP")->response() == CMD_OK } -sub _DATA { shift->command("DATA")->response() == CMD_MORE } -sub _SITE { shift->command("SITE",@_) } - -# Level 2 - -sub _LOGI { shift->command("LOGI", @_)->response() == CMD_OK } -sub _LEVE { shift->command("LEVE", @_)->response() == CMD_OK } -sub _ALER { shift->command("ALER", @_)->response() == CMD_OK } -sub _COVE { shift->command("COVE", @_)->response() == CMD_OK } -sub _HOLD { shift->command("HOLD", @_)->response() == CMD_OK } -sub _CALL { shift->command("CALL", @_)->response() == CMD_OK } -sub _SUBJ { shift->command("SUBJ", @_)->response() == CMD_OK } - -# NonStandard - -sub _XWHO { shift->command("XWHO")->response() == CMD_OK } - -1; -__END__ - -=head1 NAME - -Net::SNPP - Simple Network Pager Protocol Client - -=head1 SYNOPSIS - - use Net::SNPP; - - # Constructors - $snpp = Net::SNPP->new('snpphost'); - $snpp = Net::SNPP->new('snpphost', Timeout => 60); - -=head1 NOTE - -This module is not complete, yet ! - -=head1 DESCRIPTION - -This module implements a client interface to the SNPP protocol, enabling -a perl5 application to talk to SNPP servers. This documentation assumes -that you are familiar with the SNPP protocol described in RFC1861. - -A new Net::SNPP object must be created with the I method. Once -this has been done, all SNPP commands are accessed through this object. - -=head1 EXAMPLES - -This example will send a pager message in one hour saying "Your lunch is ready" - - #!/usr/local/bin/perl -w - - use Net::SNPP; - - $snpp = Net::SNPP->new('snpphost'); - - $snpp->send( Pager => $some_pager_number, - Message => "Your lunch is ready", - Alert => 1, - Hold => time + 3600, # lunch ready in 1 hour :-) - ) || die $snpp->message; - - $snpp->quit; - -=head1 CONSTRUCTOR - -=over 4 - -=item new ( [ HOST, ] [ OPTIONS ] ) - -This is the constructor for a new Net::SNPP object. C is the -name of the remote host to which a SNPP connection is required. - -If C is not given, then the C specified in C -will be used. - -C are passed in a hash like fashion, using key and value pairs. -Possible options are: - -B - Maximum time, in seconds, to wait for a response from the -SNPP server (default: 120) - -B - Enable debugging information - - -Example: - - - $snpp = Net::SNPP->new('snpphost', - Debug => 1, - ); - -=head1 METHODS - -Unless otherwise stated all methods return either a I or I -value, with I meaning that the operation was a success. When a method -states that it returns a value, failure will be returned as I or an -empty list. - -=over 4 - -=item reset () - -=item help () - -Request help text from the server. Returns the text or undef upon failure - -=item quit () - -Send the QUIT command to the remote SNPP server and close the socket connection. - -=back - -=head1 EXPORTS - -C exports all that C exports, plus three more subroutines -that can bu used to compare against the result of C. These are :- -C, C, and C. - -=head1 SEE ALSO - -L -RFC1861 - -=head1 AUTHOR - -Graham Barr - -=head1 COPYRIGHT - -Copyright (c) 1995-1997 Graham Barr. All rights reserved. -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut diff --git a/lib/Net/t/ph.t b/lib/Net/t/ph.t deleted file mode 100644 index 41ddab6..0000000 --- a/lib/Net/t/ph.t +++ /dev/null @@ -1,31 +0,0 @@ -#!./perl -w - -use Net::Config; -use Net::PH; - -unless(@{$NetConfig{ph_hosts}} && $NetConfig{test_hosts}) { - print "1..0\n"; - exit 0; -} - -print "1..5\n"; - -my $i = 1; - -$ph = Net::PH->new(Debug => 0) - or (print("not ok 1\n"), exit); - -print "ok 1\n"; - -$ph->fields or print "not "; -print "ok 2\n"; - -$ph->siteinfo or print "not "; -print "ok 3\n"; - -$ph->id or print "not "; -print "ok 4\n"; - -$ph->quit or print "not "; -print "ok 5\n"; - diff --git a/lib/Net/t/require.t b/lib/Net/t/require.t index f9eba4d..39d8f7e 100644 --- a/lib/Net/t/require.t +++ b/lib/Net/t/require.t @@ -1,5 +1,5 @@ -print "1..11\n"; +print "1..9\n"; my $i = 1; eval { require Net::Config; } || print "not "; print "ok ",$i++,"\n"; eval { require Net::Domain; } || print "not "; print "ok ",$i++,"\n"; @@ -8,8 +8,6 @@ eval { require Net::Netrc; } || print "not "; print "ok ",$i++,"\n"; eval { require Net::FTP; } || print "not "; print "ok ",$i++,"\n"; eval { require Net::SMTP; } || print "not "; print "ok ",$i++,"\n"; eval { require Net::NNTP; } || print "not "; print "ok ",$i++,"\n"; -eval { require Net::SNPP; } || print "not "; print "ok ",$i++,"\n"; -eval { require Net::PH; } || print "not "; print "ok ",$i++,"\n"; eval { require Net::POP3; } || print "not "; print "ok ",$i++,"\n"; eval { require Net::Time; } || print "not "; print "ok ",$i++,"\n"; diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index e5df1f8..0a7a762 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -714,6 +714,8 @@ sub _parse_test_line { $tot->{ok}++; $test->{skipped}++ if $isskip; + $reason = '[no reason given]' + if $isskip and not defined $reason; if (defined $reason and defined $test->{skip_reason}) { # print "was: '$skip_reason' new '$reason'\n"; $test->{skip_reason} = 'various reasons' diff --git a/lib/Tie/Hash.pm b/lib/Tie/Hash.pm index 3231155..91ccbee 100644 --- a/lib/Tie/Hash.pm +++ b/lib/Tie/Hash.pm @@ -65,11 +65,11 @@ Retrieve the datum in I for the tied hash I. =item FIRSTKEY this -Return the (key, value) pair for the first key in the hash. +Return the first key in the hash. =item NEXTKEY this, lastkey -Return the next key for the hash. +Return the next key in the hash. =item EXISTS this, key diff --git a/lib/Unicode/UCD.pm b/lib/Unicode/UCD.pm index ce657a1..ff819cd 100644 --- a/lib/Unicode/UCD.pm +++ b/lib/Unicode/UCD.pm @@ -3,12 +3,15 @@ package Unicode::UCD; use strict; use warnings; -our $VERSION = '3.1.0'; +our $VERSION = '0.1'; require Exporter; our @ISA = qw(Exporter); -our @EXPORT_OK = qw(charinfo charblock); +our @EXPORT_OK = qw(charinfo + charblock charscript + charblocks charscripts + charinrange); use Carp; @@ -18,14 +21,14 @@ Unicode::UCD - Unicode character database =head1 SYNOPSIS - use Unicode::UCD 3.1.0; - # requires that level of the Unicode character database - use Unicode::UCD 'charinfo'; - my %charinfo = charinfo($codepoint); + my %charinfo = charinfo($codepoint); use Unicode::UCD 'charblock'; - my $charblock = charblock($codepoint); + my $charblock = charblock($codepoint); + + use Unicode::UCD 'charscript'; + my $charscript = charblock($codepoint); =head1 DESCRIPTION @@ -34,8 +37,10 @@ Database. =cut -my $UNICODE; -my $BLOCKS; +my $UNICODEFH; +my $BLOCKSFH; +my $SCRIPTSFH; +my $VERSIONFH; sub openunicode { my ($rfh, @path) = @_; @@ -44,14 +49,12 @@ sub openunicode { for my $d (@INC) { use File::Spec; $f = File::Spec->catfile($d, "unicode", @path); - if (open($$rfh, $f)) { - last; - } else { - croak __PACKAGE__, ": open '$f' failed: $!\n"; - } + last if open($$rfh, $f); + undef $f; } - croak __PACKAGE__, ": failed to find ",join("/",@path)," in @INC\n" - unless defined $rfh; + croak __PACKAGE__, ": failed to find ", + File::Spec->catfile(@path), " in @INC" + unless defined $f; } return $f; } @@ -82,25 +85,49 @@ by the Unicode standard: upper uppercase equivalent mapping lower lowercase equivalent mapping title titlecase equivalent mapping + block block the character belongs to (used in \p{In...}) + script script the character belongs to If no match is found, an empty hash is returned. -The C property is the same as as returned by charinfo(). -(It is not defined in the Unicode Character Database proper but -instead in an auxiliary database.) +The C property is the same as as returned by charinfo(). It is +not defined in the Unicode Character Database proper (Chapter 4 of the +Unicode 3.0 Standard) but instead in an auxiliary database (Chapter 14 +of TUS3). Similarly for the C