diff options
| -rw-r--r-- | Changes | 385 | ||||
| -rw-r--r-- | MANIFEST | 19 | ||||
| -rw-r--r-- | embedvar.h | 20 | ||||
| -rw-r--r-- | ext/B/B/Concise.pm | 7 | ||||
| -rw-r--r-- | ext/B/B/Deparse.pm | 80 | ||||
| -rw-r--r-- | ext/IO/lib/IO/Socket.pm | 26 | ||||
| -rw-r--r-- | ext/PerlIO/Scalar/Scalar.xs | 7 | ||||
| -rw-r--r-- | global.sym | 3 | ||||
| -rw-r--r-- | hints/hpux.sh | 7 | ||||
| -rwxr-xr-x | installperl | 25 | ||||
| -rw-r--r-- | intrpvar.h | 11 | ||||
| -rw-r--r-- | lib/NEXT.pm | 140 | ||||
| -rw-r--r-- | lib/Switch.pm | 16 | ||||
| -rw-r--r-- | patchlevel.h | 2 | ||||
| -rw-r--r-- | perl.c | 5 | ||||
| -rw-r--r-- | perl.h | 2 | ||||
| -rw-r--r-- | perlapi.c | 25 | ||||
| -rw-r--r-- | perlapi.h | 10 | ||||
| -rw-r--r-- | perlio.c | 4 | ||||
| -rw-r--r-- | pod/perlapi.pod | 16 | ||||
| -rw-r--r-- | pod/perldata.pod | 15 | ||||
| -rw-r--r-- | pod/perldiag.pod | 6 | ||||
| -rw-r--r-- | pod/perlfaq.pod | 4 | ||||
| -rw-r--r-- | pod/perlfaq5.pod | 28 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 7 | ||||
| -rw-r--r-- | pod/perlobj.pod | 26 | ||||
| -rw-r--r-- | regcomp.c | 1 | ||||
| -rw-r--r-- | regexec.c | 40 | ||||
| -rw-r--r-- | sv.c | 7 | ||||
| -rw-r--r-- | t/io/fflush.t | 125 | ||||
| -rw-r--r-- | t/lib/b-deparse.t | 150 | ||||
| -rw-r--r-- | t/lib/io_scalar.t | 17 | ||||
| -rwxr-xr-x[-rw-r--r--] | t/lib/mimeqp.t | 0 | ||||
| -rw-r--r-- | t/lib/next.t | 99 | ||||
| -rw-r--r-- | t/lib/selfstubber.t | 8 | ||||
| -rw-r--r-- | t/lib/switch.t | 12 | ||||
| -rw-r--r-- | t/lib/syslfs.t | 2 | ||||
| -rw-r--r-- | t/lib/tie-refhash.t | 42 | ||||
| -rwxr-xr-x | t/op/die_exit.t | 2 | ||||
| -rwxr-xr-x | t/op/lex_assign.t | 1 | ||||
| -rw-r--r-- | t/op/lfs.t | 2 | ||||
| -rw-r--r-- | t/op/re_tests | 1 | ||||
| -rwxr-xr-x | t/op/subst.t | 6 | ||||
| -rwxr-xr-x | t/op/taint.t | 2 | ||||
| -rw-r--r--[-rwxr-xr-x] | t/op/utf8decode.t | 0 | ||||
| -rw-r--r-- | thrdvar.h | 2 | ||||
| -rw-r--r-- | toke.c | 11 | ||||
| -rw-r--r-- | util.c | 12 |
48 files changed, 1182 insertions, 256 deletions
@@ -31,6 +31,391 @@ or any other branch. Version v5.7.1 Development release working toward v5.8 -------------- ____________________________________________________________________________ +[ 9916] By: jhi on 2001/04/30 12:57:03 + Log: T_w_e_a_k_a_g_e. + Branch: perl + ! pod/perldata.pod pod/perldiag.pod +____________________________________________________________________________ +[ 9915] By: jhi on 2001/04/30 12:39:29 + Log: Install s2p also as psed. + + TODO: psed documentation? + Branch: perl + ! installperl +____________________________________________________________________________ +[ 9914] By: jhi on 2001/04/30 12:29:21 + Log: Subject: Re: [ID 20010303.009] SOCKS5 work around breaks other sockets + From: Jens Hamisch <jens@Strawberry.COM> + Date: Fri, 27 Apr 2001 17:00:36 +0200 + Message-ID: <20010427170036.K1372@Strawberry.COM> + + SOCKS5_VERSION_NAME is the right symbol to detect + the presence of SOCKS5. (HAS_SOCKS5_INIT is telling whether + function called socks5_init() is available, and even that is + not universal, most SOCKS5 installations use SOCKSinit()). + Branch: perl + ! perlio.c +____________________________________________________________________________ +[ 9913] By: jhi on 2001/04/30 12:22:15 + Log: Allow a zero timeout on IO::Socket accept and connect-- + though one really shouldn't do that. Based on + + Subject: Not possible to set zero second timeout on accept() in IO::Socket and company.. + From: "John Holdsworth" <coldwave@bigfoot.com> + Date: Sun, 4 Feb 2001 12:48:18 +0100 + Message-ID: <005a01c08ea0$5e6039d0$03ac2ac0@planc> + Branch: perl + ! ext/IO/lib/IO/Socket.pm +____________________________________________________________________________ +[ 9912] By: jhi on 2001/04/30 11:27:27 + Log: Save the spot of regprev (see #9911) for binary compatibility; + regen API. + Branch: perl + ! embedvar.h perlapi.h thrdvar.h +____________________________________________________________________________ +[ 9911] By: jhi on 2001/04/30 11:22:03 + Log: Subject: Re: [PATCH bleadperl] [ID 20010426.002] Word boundry regex [...] + From: Hugo <hv@crypt.compulink.co.uk> + Date: Sun, 29 Apr 2001 17:09:30 +0100 + Message-Id: <200104291609.RAA17790@crypt.compulink.co.uk> + Branch: perl + ! regcomp.c regexec.c sv.c t/op/re_tests t/op/subst.t thrdvar.h +____________________________________________________________________________ +[ 9910] By: jhi on 2001/04/30 11:15:12 + Log: Change PL_numeric_radix to PL_numeric_radix_sv (and leave in + a dummy for PL_numeric_radix); no pressing reason to break + binary compatibility; regen API. + Branch: perl + ! embedvar.h global.sym intrpvar.h objXSUB.h perl.c perl.h + ! perlapi.c perlapi.h pod/perlapi.pod sv.c util.c +____________________________________________________________________________ +[ 9909] By: jhi on 2001/04/30 10:56:08 + Log: Subject: [DOC PATCH bleadperl] Document generation of random integers + From: Walt Mankowski <waltman@netaxs.com> + Date: Sun, 29 Apr 2001 21:53:48 -0400 + Message-ID: <20010429215348.A3971@netaxs.com> + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 9908] By: jhi on 2001/04/30 10:49:40 + Log: Reintroduce #9889 to unbuffer the stderr/stdout on stdio configs. + Branch: perl + ! t/lib/selfstubber.t +____________________________________________________________________________ +[ 9907] By: nick on 2001/04/30 09:26:50 + Log: Integrate mainline. + Branch: perlio + !> pod/perldata.pod pod/perldiag.pod t/pragma/warn/toke toke.c +____________________________________________________________________________ +[ 9906] By: jhi on 2001/04/29 23:24:20 + Log: Abigail spotted a thinko in #9905. + Branch: perl + ! pod/perldiag.pod +____________________________________________________________________________ +[ 9905] By: jhi on 2001/04/29 15:55:39 + Log: Changed the underscore/undebar syntax in numeric constants; + now any grouping will do, as long as the underscores are not + consecutive (so "zero-grouping" is out), and they do not begin + or end the integer or fractional parts. + Branch: perl + ! pod/perldata.pod pod/perldiag.pod t/pragma/warn/toke toke.c +____________________________________________________________________________ +[ 9904] By: nick on 2001/04/29 15:43:22 + Log: Integrate mainline. + Branch: perlio + +> (branch 98 files) + - lib/unicode/Block.pl + - lib/unicode/In/AlphabeticPresentationForms.pl + - lib/unicode/In/Arabic.pl + - lib/unicode/In/ArabicPresentationForms-A.pl + - lib/unicode/In/ArabicPresentationForms-B.pl + - lib/unicode/In/Armenian.pl lib/unicode/In/Arrows.pl + - lib/unicode/In/BasicLatin.pl lib/unicode/In/Bengali.pl + - lib/unicode/In/BlockElements.pl lib/unicode/In/Bopomofo.pl + - lib/unicode/In/BopomofoExtended.pl + - lib/unicode/In/BoxDrawing.pl lib/unicode/In/BraillePatterns.pl + - lib/unicode/In/CJKCompatibility.pl + - lib/unicode/In/CJKCompatibilityForms.pl + - lib/unicode/In/CJKCompatibilityIdeographs.pl + - lib/unicode/In/CJKRadicalsSupplement.pl + - lib/unicode/In/CJKSymbolsandPunctuation.pl + - lib/unicode/In/CJKUnifiedIdeographs.pl + - lib/unicode/In/CJKUnifiedIdeographsExtensionA.pl + - lib/unicode/In/Cherokee.pl + - lib/unicode/In/CombiningDiacriticalMarks.pl + - lib/unicode/In/CombiningHalfMarks.pl + - lib/unicode/In/CombiningMarksforSymbols.pl + - lib/unicode/In/ControlPictures.pl + - lib/unicode/In/CurrencySymbols.pl lib/unicode/In/Cyrillic.pl + - lib/unicode/In/Devanagari.pl lib/unicode/In/Dingbats.pl + - lib/unicode/In/EnclosedAlphanumerics.pl + - lib/unicode/In/EnclosedCJKLettersandMonths.pl + - lib/unicode/In/Ethiopic.pl + - lib/unicode/In/GeneralPunctuation.pl + - lib/unicode/In/GeometricShapes.pl lib/unicode/In/Georgian.pl + - lib/unicode/In/Greek.pl lib/unicode/In/GreekExtended.pl + - lib/unicode/In/Gujarati.pl lib/unicode/In/Gurmukhi.pl + - lib/unicode/In/HalfwidthandFullwidthForms.pl + - lib/unicode/In/HangulCompatibilityJamo.pl + - lib/unicode/In/HangulJamo.pl lib/unicode/In/HangulSyllables.pl + - lib/unicode/In/Hebrew.pl + - lib/unicode/In/HighPrivateUseSurrogates.pl + - lib/unicode/In/HighSurrogates.pl lib/unicode/In/Hiragana.pl + - lib/unicode/In/IPAExtensions.pl + - lib/unicode/In/IdeographicDescriptionCharacters.pl + - lib/unicode/In/Kanbun.pl lib/unicode/In/KangxiRadicals.pl + - lib/unicode/In/Kannada.pl lib/unicode/In/Katakana.pl + - lib/unicode/In/Khmer.pl lib/unicode/In/Lao.pl + - lib/unicode/In/Latin-1Supplement.pl + - lib/unicode/In/LatinExtended-A.pl + - lib/unicode/In/LatinExtended-B.pl + - lib/unicode/In/LatinExtendedAdditional.pl + - lib/unicode/In/LetterlikeSymbols.pl + - lib/unicode/In/LowSurrogates.pl lib/unicode/In/Malayalam.pl + - lib/unicode/In/MathematicalOperators.pl + - lib/unicode/In/MiscellaneousSymbols.pl + - lib/unicode/In/MiscellaneousTechnical.pl + - lib/unicode/In/Mongolian.pl lib/unicode/In/Myanmar.pl + - lib/unicode/In/NumberForms.pl lib/unicode/In/Ogham.pl + - lib/unicode/In/OpticalCharacterRecognition.pl + - lib/unicode/In/Oriya.pl lib/unicode/In/PrivateUse.pl + - lib/unicode/In/Runic.pl lib/unicode/In/Sinhala.pl + - lib/unicode/In/SmallFormVariants.pl + - lib/unicode/In/SpacingModifierLetters.pl + - lib/unicode/In/Specials.pl + - lib/unicode/In/SuperscriptsandSubscripts.pl + - lib/unicode/In/Syriac.pl lib/unicode/In/Tamil.pl + - lib/unicode/In/Telugu.pl lib/unicode/In/Thaana.pl + - lib/unicode/In/Thai.pl lib/unicode/In/Tibetan.pl + - lib/unicode/In/UnifiedCanadianAboriginalSyllabics.pl + - lib/unicode/In/YiRadicals.pl lib/unicode/In/YiSyllables.pl + !> INSTALL MANIFEST doop.c embed.h embed.pl ext/B/B/Deparse.pm + !> ext/IO/lib/IO/Seekable.pm hints/hpux.sh + !> lib/unicode/mktables.PL lib/utf8_heavy.pl objXSUB.h perl.h + !> pod/perldiag.pod pod/perlunicode.pod proto.h regcomp.c + !> regexec.c t/lib/b-deparse.t t/lib/selfstubber.t t/op/pat.t + !> utf8.c win32/Makefile +____________________________________________________________________________ +[ 9903] By: jhi on 2001/04/29 14:30:53 + Log: Subject: [PATCH: perl@9885] win32/Makefile (nmake) update + From: Prymmer/Kahn <pvhp@best.com> + Date: Sat, 28 Apr 2001 21:56:51 -0700 (PDT) + Message-ID: <Pine.BSF.4.21.0104282147270.2927-100000@shell8.ba.best.com> + Branch: perl + ! win32/Makefile +____________________________________________________________________________ +[ 9902] By: jhi on 2001/04/29 02:52:44 + Log: Subject: [PATCH ext/IO/lib/IO/Seekable.pm] Doc fixes. + From: "Abigail" <abigail@foad.org> + Date: Sun, 29 Apr 2001 03:14:25 +0200 + Message-ID: <20010429011425.24503.qmail@foad.org> + Branch: perl + ! ext/IO/lib/IO/Seekable.pm +____________________________________________________________________________ +[ 9901] By: jhi on 2001/04/29 02:04:46 + Log: In character classes one couldn't have 0x80..0xff characters + at the left hand side if there were 0x100.. characters in the + character class. + Branch: perl + ! doop.c embed.h embed.pl objXSUB.h proto.h regcomp.c regexec.c + ! t/op/pat.t utf8.c +____________________________________________________________________________ +[ 9900] By: jhi on 2001/04/28 22:55:04 + Log: Forgot the latest mktables.PL from #9899. + Branch: perl + ! lib/unicode/mktables.PL +____________________________________________________________________________ +[ 9899] By: jhi on 2001/04/28 22:53:28 + Log: Explain the \p{} and \P{} error message better and + have prettier prettyprint in In.pl. + Branch: perl + ! lib/unicode/In.pl lib/unicode/mktables.PL lib/utf8_heavy.pl + ! pod/perldiag.pod +____________________________________________________________________________ +[ 9898] By: jhi on 2001/04/28 21:03:34 + Log: Add one possible explanation for the "Invalid [] range" error. + Branch: perl + ! pod/perldiag.pod +____________________________________________________________________________ +[ 9897] By: jhi on 2001/04/28 17:18:26 + Log: Add a level of indirection to the implementation of \p{InFoo} + so that we don't have to have long filenames. (Nothing changes + in the user interface.) The indirection is defined in + the file lib/unicode/In.pl and it is handled in lib/utf8_heavy.pl. + Also rename some the character classes by removing '-' from + the classnames, and finally renamed Block.pl as Blocks.pl. + Branch: perl + + lib/unicode/Blocks.pl lib/unicode/In.pl 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/14.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/2.pl + + lib/unicode/In/20.pl lib/unicode/In/21.pl lib/unicode/In/22.pl + + lib/unicode/In/23.pl lib/unicode/In/24.pl lib/unicode/In/25.pl + + lib/unicode/In/26.pl lib/unicode/In/27.pl lib/unicode/In/28.pl + + lib/unicode/In/29.pl lib/unicode/In/3.pl lib/unicode/In/30.pl + + lib/unicode/In/31.pl lib/unicode/In/32.pl lib/unicode/In/33.pl + + lib/unicode/In/34.pl lib/unicode/In/35.pl lib/unicode/In/36.pl + + lib/unicode/In/37.pl lib/unicode/In/38.pl lib/unicode/In/39.pl + + lib/unicode/In/4.pl lib/unicode/In/40.pl lib/unicode/In/41.pl + + lib/unicode/In/42.pl lib/unicode/In/43.pl lib/unicode/In/44.pl + + lib/unicode/In/45.pl lib/unicode/In/46.pl lib/unicode/In/47.pl + + lib/unicode/In/48.pl lib/unicode/In/49.pl lib/unicode/In/5.pl + + lib/unicode/In/50.pl lib/unicode/In/51.pl lib/unicode/In/52.pl + + lib/unicode/In/53.pl lib/unicode/In/54.pl lib/unicode/In/55.pl + + lib/unicode/In/56.pl lib/unicode/In/57.pl lib/unicode/In/58.pl + + lib/unicode/In/59.pl lib/unicode/In/6.pl lib/unicode/In/60.pl + + lib/unicode/In/61.pl lib/unicode/In/62.pl lib/unicode/In/63.pl + + lib/unicode/In/64.pl lib/unicode/In/65.pl lib/unicode/In/66.pl + + lib/unicode/In/67.pl lib/unicode/In/68.pl lib/unicode/In/69.pl + + lib/unicode/In/7.pl lib/unicode/In/70.pl lib/unicode/In/71.pl + + lib/unicode/In/72.pl lib/unicode/In/73.pl lib/unicode/In/74.pl + + lib/unicode/In/75.pl lib/unicode/In/76.pl lib/unicode/In/77.pl + + lib/unicode/In/78.pl lib/unicode/In/79.pl lib/unicode/In/8.pl + + lib/unicode/In/80.pl lib/unicode/In/81.pl lib/unicode/In/82.pl + + lib/unicode/In/83.pl lib/unicode/In/84.pl lib/unicode/In/85.pl + + lib/unicode/In/86.pl lib/unicode/In/87.pl lib/unicode/In/88.pl + + lib/unicode/In/89.pl lib/unicode/In/9.pl lib/unicode/In/90.pl + + lib/unicode/In/91.pl lib/unicode/In/92.pl lib/unicode/In/93.pl + + lib/unicode/In/94.pl lib/unicode/In/95.pl + - lib/unicode/Block.pl + - lib/unicode/In/AlphabeticPresentationForms.pl + - lib/unicode/In/Arabic.pl + - lib/unicode/In/ArabicPresentationForms-A.pl + - lib/unicode/In/ArabicPresentationForms-B.pl + - lib/unicode/In/Armenian.pl lib/unicode/In/Arrows.pl + - lib/unicode/In/BasicLatin.pl lib/unicode/In/Bengali.pl + - lib/unicode/In/BlockElements.pl lib/unicode/In/Bopomofo.pl + - lib/unicode/In/BopomofoExtended.pl + - lib/unicode/In/BoxDrawing.pl lib/unicode/In/BraillePatterns.pl + - lib/unicode/In/CJKCompatibility.pl + - lib/unicode/In/CJKCompatibilityForms.pl + - lib/unicode/In/CJKCompatibilityIdeographs.pl + - lib/unicode/In/CJKRadicalsSupplement.pl + - lib/unicode/In/CJKSymbolsandPunctuation.pl + - lib/unicode/In/CJKUnifiedIdeographs.pl + - lib/unicode/In/CJKUnifiedIdeographsExtensionA.pl + - lib/unicode/In/Cherokee.pl + - lib/unicode/In/CombiningDiacriticalMarks.pl + - lib/unicode/In/CombiningHalfMarks.pl + - lib/unicode/In/CombiningMarksforSymbols.pl + - lib/unicode/In/ControlPictures.pl + - lib/unicode/In/CurrencySymbols.pl lib/unicode/In/Cyrillic.pl + - lib/unicode/In/Devanagari.pl lib/unicode/In/Dingbats.pl + - lib/unicode/In/EnclosedAlphanumerics.pl + - lib/unicode/In/EnclosedCJKLettersandMonths.pl + - lib/unicode/In/Ethiopic.pl + - lib/unicode/In/GeneralPunctuation.pl + - lib/unicode/In/GeometricShapes.pl lib/unicode/In/Georgian.pl + - lib/unicode/In/Greek.pl lib/unicode/In/GreekExtended.pl + - lib/unicode/In/Gujarati.pl lib/unicode/In/Gurmukhi.pl + - lib/unicode/In/HalfwidthandFullwidthForms.pl + - lib/unicode/In/HangulCompatibilityJamo.pl + - lib/unicode/In/HangulJamo.pl lib/unicode/In/HangulSyllables.pl + - lib/unicode/In/Hebrew.pl + - lib/unicode/In/HighPrivateUseSurrogates.pl + - lib/unicode/In/HighSurrogates.pl lib/unicode/In/Hiragana.pl + - lib/unicode/In/IPAExtensions.pl + - lib/unicode/In/IdeographicDescriptionCharacters.pl + - lib/unicode/In/Kanbun.pl lib/unicode/In/KangxiRadicals.pl + - lib/unicode/In/Kannada.pl lib/unicode/In/Katakana.pl + - lib/unicode/In/Khmer.pl lib/unicode/In/Lao.pl + - lib/unicode/In/Latin-1Supplement.pl + - lib/unicode/In/LatinExtended-A.pl + - lib/unicode/In/LatinExtended-B.pl + - lib/unicode/In/LatinExtendedAdditional.pl + - lib/unicode/In/LetterlikeSymbols.pl + - lib/unicode/In/LowSurrogates.pl lib/unicode/In/Malayalam.pl + - lib/unicode/In/MathematicalOperators.pl + - lib/unicode/In/MiscellaneousSymbols.pl + - lib/unicode/In/MiscellaneousTechnical.pl + - lib/unicode/In/Mongolian.pl lib/unicode/In/Myanmar.pl + - lib/unicode/In/NumberForms.pl lib/unicode/In/Ogham.pl + - lib/unicode/In/OpticalCharacterRecognition.pl + - lib/unicode/In/Oriya.pl lib/unicode/In/PrivateUse.pl + - lib/unicode/In/Runic.pl lib/unicode/In/Sinhala.pl + - lib/unicode/In/SmallFormVariants.pl + - lib/unicode/In/SpacingModifierLetters.pl + - lib/unicode/In/Specials.pl + - lib/unicode/In/SuperscriptsandSubscripts.pl + - lib/unicode/In/Syriac.pl lib/unicode/In/Tamil.pl + - lib/unicode/In/Telugu.pl lib/unicode/In/Thaana.pl + - lib/unicode/In/Thai.pl lib/unicode/In/Tibetan.pl + - lib/unicode/In/UnifiedCanadianAboriginalSyllabics.pl + - lib/unicode/In/YiRadicals.pl lib/unicode/In/YiSyllables.pl + ! MANIFEST lib/unicode/mktables.PL lib/utf8_heavy.pl + ! pod/perlunicode.pod +____________________________________________________________________________ +[ 9896] By: jhi on 2001/04/28 14:33:17 + Log: Update the information on shared library path on HP-UX. + Branch: perl + ! INSTALL +____________________________________________________________________________ +[ 9895] By: jhi on 2001/04/28 14:32:30 + Log: Because #9894 seems to do the trick, this workaround can be removed. + Branch: perl + ! t/lib/selfstubber.t +____________________________________________________________________________ +[ 9894] By: jhi on 2001/04/28 14:26:13 + Log: For PerlIO flush the children's file handles (on fork/exec/system). + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 9893] By: jhi on 2001/04/28 14:23:15 + Log: Test tweak for #9891. + Branch: perl + ! t/lib/b-deparse.t +____________________________________________________________________________ +[ 9892] By: jhi on 2001/04/28 14:10:13 + Log: New HP-UX hints from Merijn. + Branch: perl + ! hints/hpux.sh +____________________________________________________________________________ +[ 9891] By: jhi on 2001/04/28 14:07:27 + Log: Subject: [PATCH B::Deparse] non-block scopes + From: Robin Houston <robin@kitsite.com> + Date: Fri, 27 Apr 2001 19:15:14 +0100 + Message-ID: <20010427191514.A30951@puffinry.freeserve.co.uk> + Branch: perl + ! ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 9890] By: nick on 2001/04/27 19:41:25 + Log: Integrate mainline + Branch: perlio + +> t/lib/selfstubber.t + !> (integrate 50 files) +____________________________________________________________________________ +[ 9889] By: jhi on 2001/04/27 18:23:46 + Log: Subject: Re: selfstubber test fail on bleadperl + From: Mike Guy <mjtg@cam.ac.uk> + Date: Fri, 27 Apr 2001 19:31:18 +0100 + Message-Id: <E14tD1S-0001tJ-00@libra.cus.cam.ac.uk> + Branch: perl + ! t/lib/selfstubber.t +____________________________________________________________________________ +[ 9888] By: jhi on 2001/04/27 16:20:54 + Log: Test tweak for #9886. + Branch: perl + ! t/lib/b-deparse.t +____________________________________________________________________________ +[ 9887] By: jhi on 2001/04/27 16:16:33 + Log: Buffering issue at least in Solaris (even with perlio). + Branch: perl + ! t/lib/selfstubber.t +____________________________________________________________________________ +[ 9886] By: jhi on 2001/04/27 14:59:23 + Log: Subject: [PATCH B::Deparse] Human-readable pragmas &c + From: Robin Houston <robin@kitsite.com> + Date: Fri, 27 Apr 2001 16:53:20 +0100 + Message-ID: <20010427165320.A30479@puffinry.freeserve.co.uk> + Branch: perl + ! ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 9885] By: jhi on 2001/04/27 14:23:51 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ [ 9884] By: jhi on 2001/04/27 14:14:12 Log: Subject: [DOC PATCH bleadperl] Document underscores in numeric literals From: "Philip Newton" <pnewton@gmx.de> @@ -775,6 +775,7 @@ lib/Math/BigFloat.pm An arbitrary precision floating-point arithmetic package lib/Math/BigInt.pm An arbitrary precision integer arithmetic package lib/Math/Complex.pm A Complex package lib/Math/Trig.pm A simple interface to complex trigonometry +lib/NEXT.pm Pseudo-class NEXT for method redispatch lib/Net/Ping.pm Hello, anybody home? lib/Net/hostent.pm By-name interface to Perl's builtin gethost* lib/Net/netent.pm By-name interface to Perl's builtin getnet* @@ -899,14 +900,6 @@ lib/unicode/EAWidth.txt Unicode character database lib/unicode/In.pl Unicode character database lib/unicode/In/0.pl Unicode character database lib/unicode/In/1.pl Unicode character database -lib/unicode/In/2.pl Unicode character database -lib/unicode/In/3.pl Unicode character database -lib/unicode/In/4.pl Unicode character database -lib/unicode/In/5.pl Unicode character database -lib/unicode/In/6.pl Unicode character database -lib/unicode/In/7.pl Unicode character database -lib/unicode/In/8.pl Unicode character database -lib/unicode/In/9.pl Unicode character database lib/unicode/In/10.pl Unicode character database lib/unicode/In/11.pl Unicode character database lib/unicode/In/12.pl Unicode character database @@ -917,6 +910,7 @@ lib/unicode/In/16.pl Unicode character database lib/unicode/In/17.pl Unicode character database lib/unicode/In/18.pl Unicode character database lib/unicode/In/19.pl Unicode character database +lib/unicode/In/2.pl Unicode character database lib/unicode/In/20.pl Unicode character database lib/unicode/In/21.pl Unicode character database lib/unicode/In/22.pl Unicode character database @@ -927,6 +921,7 @@ lib/unicode/In/26.pl Unicode character database lib/unicode/In/27.pl Unicode character database lib/unicode/In/28.pl Unicode character database lib/unicode/In/29.pl Unicode character database +lib/unicode/In/3.pl Unicode character database lib/unicode/In/30.pl Unicode character database lib/unicode/In/31.pl Unicode character database lib/unicode/In/32.pl Unicode character database @@ -937,6 +932,7 @@ lib/unicode/In/36.pl Unicode character database lib/unicode/In/37.pl Unicode character database lib/unicode/In/38.pl Unicode character database lib/unicode/In/39.pl Unicode character database +lib/unicode/In/4.pl Unicode character database lib/unicode/In/40.pl Unicode character database lib/unicode/In/41.pl Unicode character database lib/unicode/In/42.pl Unicode character database @@ -947,6 +943,7 @@ lib/unicode/In/46.pl Unicode character database lib/unicode/In/47.pl Unicode character database lib/unicode/In/48.pl Unicode character database lib/unicode/In/49.pl Unicode character database +lib/unicode/In/5.pl Unicode character database lib/unicode/In/50.pl Unicode character database lib/unicode/In/51.pl Unicode character database lib/unicode/In/52.pl Unicode character database @@ -957,6 +954,7 @@ lib/unicode/In/56.pl Unicode character database lib/unicode/In/57.pl Unicode character database lib/unicode/In/58.pl Unicode character database lib/unicode/In/59.pl Unicode character database +lib/unicode/In/6.pl Unicode character database lib/unicode/In/60.pl Unicode character database lib/unicode/In/61.pl Unicode character database lib/unicode/In/62.pl Unicode character database @@ -967,6 +965,7 @@ lib/unicode/In/66.pl Unicode character database lib/unicode/In/67.pl Unicode character database lib/unicode/In/68.pl Unicode character database lib/unicode/In/69.pl Unicode character database +lib/unicode/In/7.pl Unicode character database lib/unicode/In/70.pl Unicode character database lib/unicode/In/71.pl Unicode character database lib/unicode/In/72.pl Unicode character database @@ -977,6 +976,7 @@ lib/unicode/In/76.pl Unicode character database lib/unicode/In/77.pl Unicode character database lib/unicode/In/78.pl Unicode character database lib/unicode/In/79.pl Unicode character database +lib/unicode/In/8.pl Unicode character database lib/unicode/In/80.pl Unicode character database lib/unicode/In/81.pl Unicode character database lib/unicode/In/82.pl Unicode character database @@ -987,6 +987,7 @@ lib/unicode/In/86.pl Unicode character database lib/unicode/In/87.pl Unicode character database lib/unicode/In/88.pl Unicode character database lib/unicode/In/89.pl Unicode character database +lib/unicode/In/9.pl Unicode character database lib/unicode/In/90.pl Unicode character database lib/unicode/In/91.pl Unicode character database lib/unicode/In/92.pl Unicode character database @@ -1432,6 +1433,7 @@ t/comp/use.t See if pragmas work t/harness Finer diagnostics from test suite t/io/argv.t See if ARGV stuff works t/io/dup.t See if >& works right +t/io/fflush.t See if auto-flush on fork/exec/system/qx works t/io/fs.t See if directory manipulations work t/io/inplace.t See if inplace editing works t/io/iprefix.t See if inplace editing works with prefixes @@ -1563,6 +1565,7 @@ t/lib/mimeb64u.t see whether MIME::Base64 works t/lib/mimeqp.t see whether MIME::QuotedPrint works t/lib/ndbm.t See if NDBM_File works t/lib/net-hostent.t See if Net::hostent works +t/lib/next.t See if NEXT works t/lib/odbm.t See if ODBM_File works t/lib/opcode.t See if Opcode works t/lib/open2.t See if IPC::Open2 works diff --git a/embedvar.h b/embedvar.h index 8244cccd72..a77a2738a3 100644 --- a/embedvar.h +++ b/embedvar.h @@ -99,6 +99,7 @@ #define PL_regcode (vTHX->Tregcode) #define PL_regcomp_parse (vTHX->Tregcomp_parse) #define PL_regcomp_rx (vTHX->Tregcomp_rx) +#define PL_regcompat1 (vTHX->Tregcompat1) #define PL_regcompp (vTHX->Tregcompp) #define PL_regdata (vTHX->Tregdata) #define PL_regdummy (vTHX->Tregdummy) @@ -117,7 +118,6 @@ #define PL_regnaughty (vTHX->Tregnaughty) #define PL_regnpar (vTHX->Tregnpar) #define PL_regprecomp (vTHX->Tregprecomp) -#define PL_regprev (vTHX->Tregprev) #define PL_regprogram (vTHX->Tregprogram) #define PL_regsawback (vTHX->Tregsawback) #define PL_regseen (vTHX->Tregseen) @@ -325,9 +325,10 @@ #define PL_nthreads (PERL_GET_INTERP->Inthreads) #define PL_nthreads_cond (PERL_GET_INTERP->Inthreads_cond) #define PL_nullstash (PERL_GET_INTERP->Inullstash) +#define PL_numeric_compat1 (PERL_GET_INTERP->Inumeric_compat1) #define PL_numeric_local (PERL_GET_INTERP->Inumeric_local) #define PL_numeric_name (PERL_GET_INTERP->Inumeric_name) -#define PL_numeric_radix (PERL_GET_INTERP->Inumeric_radix) +#define PL_numeric_radix_sv (PERL_GET_INTERP->Inumeric_radix_sv) #define PL_numeric_standard (PERL_GET_INTERP->Inumeric_standard) #define PL_ofmt (PERL_GET_INTERP->Iofmt) #define PL_oldbufptr (PERL_GET_INTERP->Ioldbufptr) @@ -606,9 +607,10 @@ #define PL_nthreads (vTHX->Inthreads) #define PL_nthreads_cond (vTHX->Inthreads_cond) #define PL_nullstash (vTHX->Inullstash) +#define PL_numeric_compat1 (vTHX->Inumeric_compat1) #define PL_numeric_local (vTHX->Inumeric_local) #define PL_numeric_name (vTHX->Inumeric_name) -#define PL_numeric_radix (vTHX->Inumeric_radix) +#define PL_numeric_radix_sv (vTHX->Inumeric_radix_sv) #define PL_numeric_standard (vTHX->Inumeric_standard) #define PL_ofmt (vTHX->Iofmt) #define PL_oldbufptr (vTHX->Ioldbufptr) @@ -805,6 +807,7 @@ #define PL_regcode (aTHXo->interp.Tregcode) #define PL_regcomp_parse (aTHXo->interp.Tregcomp_parse) #define PL_regcomp_rx (aTHXo->interp.Tregcomp_rx) +#define PL_regcompat1 (aTHXo->interp.Tregcompat1) #define PL_regcompp (aTHXo->interp.Tregcompp) #define PL_regdata (aTHXo->interp.Tregdata) #define PL_regdummy (aTHXo->interp.Tregdummy) @@ -823,7 +826,6 @@ #define PL_regnaughty (aTHXo->interp.Tregnaughty) #define PL_regnpar (aTHXo->interp.Tregnpar) #define PL_regprecomp (aTHXo->interp.Tregprecomp) -#define PL_regprev (aTHXo->interp.Tregprev) #define PL_regprogram (aTHXo->interp.Tregprogram) #define PL_regsawback (aTHXo->interp.Tregsawback) #define PL_regseen (aTHXo->interp.Tregseen) @@ -1023,9 +1025,10 @@ #define PL_nthreads (aTHXo->interp.Inthreads) #define PL_nthreads_cond (aTHXo->interp.Inthreads_cond) #define PL_nullstash (aTHXo->interp.Inullstash) +#define PL_numeric_compat1 (aTHXo->interp.Inumeric_compat1) #define PL_numeric_local (aTHXo->interp.Inumeric_local) #define PL_numeric_name (aTHXo->interp.Inumeric_name) -#define PL_numeric_radix (aTHXo->interp.Inumeric_radix) +#define PL_numeric_radix_sv (aTHXo->interp.Inumeric_radix_sv) #define PL_numeric_standard (aTHXo->interp.Inumeric_standard) #define PL_ofmt (aTHXo->interp.Iofmt) #define PL_oldbufptr (aTHXo->interp.Ioldbufptr) @@ -1305,9 +1308,10 @@ #define PL_Inthreads PL_nthreads #define PL_Inthreads_cond PL_nthreads_cond #define PL_Inullstash PL_nullstash +#define PL_Inumeric_compat1 PL_numeric_compat1 #define PL_Inumeric_local PL_numeric_local #define PL_Inumeric_name PL_numeric_name -#define PL_Inumeric_radix PL_numeric_radix +#define PL_Inumeric_radix_sv PL_numeric_radix_sv #define PL_Inumeric_standard PL_numeric_standard #define PL_Iofmt PL_ofmt #define PL_Ioldbufptr PL_oldbufptr @@ -1500,6 +1504,7 @@ #define PL_regcode (aTHX->Tregcode) #define PL_regcomp_parse (aTHX->Tregcomp_parse) #define PL_regcomp_rx (aTHX->Tregcomp_rx) +#define PL_regcompat1 (aTHX->Tregcompat1) #define PL_regcompp (aTHX->Tregcompp) #define PL_regdata (aTHX->Tregdata) #define PL_regdummy (aTHX->Tregdummy) @@ -1518,7 +1523,6 @@ #define PL_regnaughty (aTHX->Tregnaughty) #define PL_regnpar (aTHX->Tregnpar) #define PL_regprecomp (aTHX->Tregprecomp) -#define PL_regprev (aTHX->Tregprev) #define PL_regprogram (aTHX->Tregprogram) #define PL_regsawback (aTHX->Tregsawback) #define PL_regseen (aTHX->Tregseen) @@ -1636,6 +1640,7 @@ #define PL_Tregcode PL_regcode #define PL_Tregcomp_parse PL_regcomp_parse #define PL_Tregcomp_rx PL_regcomp_rx +#define PL_Tregcompat1 PL_regcompat1 #define PL_Tregcompp PL_regcompp #define PL_Tregdata PL_regdata #define PL_Tregdummy PL_regdummy @@ -1654,7 +1659,6 @@ #define PL_Tregnaughty PL_regnaughty #define PL_Tregnpar PL_regnpar #define PL_Tregprecomp PL_regprecomp -#define PL_Tregprev PL_regprev #define PL_Tregprogram PL_regprogram #define PL_Tregsawback PL_regsawback #define PL_Tregseen PL_regseen diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index cd657c0831..2663b9179c 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -153,8 +153,9 @@ my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|", 'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*", 'PVOP' => '"', 'LOOP' => "{", 'COP' => ";"); -my @linenoise = ('#', - qw'() sc ( @? 1 $* gv *{ m$ m@ m% m? p/ *$ $ $# & a& pt \\ s\\ rf bl +no warnings 'qw'; # "Possible attempt to put comments..." +my @linenoise = + qw'# () sc ( @? 1 $* gv *{ m$ m@ m% m? p/ *$ $ $# & a& pt \\ s\\ rf bl ` *? <> ?? ?/ r/ c/ // qr s/ /c y/ = @= C sC Cp sp df un BM po +1 +I -1 -I 1+ I+ 1- I- ** * i* / i/ %$ i% x + i+ - i- . " << >> < i< > i> <= i, >= i. == i= != i! <? i? s< s> s, s. s= s! s? b& b^ b| -0 -i @@ -168,7 +169,7 @@ my @linenoise = ('#', co cr u. cm ut r. l@ s@ r@ mD uD oD rD tD sD wD cD f$ w$ p$ sh e$ k$ g3 g4 s4 g5 s5 T@ C@ L@ G@ A@ S@ Hg Hc Hr Hw Mg Mc Ms Mr Sg Sc So rq do {e e} {t t} g6 G6 6e g7 G7 7e g8 G8 8e g9 G9 9e 6s 7s 8s 9s 6E 7E 8E 9E Pn - Pu GP SP EP Gn Gg GG SG EG g0 c$ lk t$ ;s n>'); + Pu GP SP EP Gn Gg GG SG EG g0 c$ lk t$ ;s n>'; my $chars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index 7e57a58b51..6e42a48046 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -13,7 +13,8 @@ use B qw(class main_root main_start main_cv svref_2object opnumber cstring OPf_KIDS OPf_REF OPf_STACKED OPf_SPECIAL OPpLVAL_INTRO OPpENTERSUB_AMPER OPpSLICE OPpCONST_BARE OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY - OPpCONST_ARYBASE OPpEXISTS_SUB + OPpCONST_ARYBASE OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER + OPpSORT_REVERSE SVf_IOK SVf_NOK SVf_ROK SVf_POK CVf_METHOD CVf_LOCKED CVf_LVALUE PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE PMf_SKIPWHITE @@ -205,6 +206,13 @@ use warnings (); # 1 statement modifiers # 0 statement level +# Also, lineseq may pass a fourth parameter to the pp_ routines: +# if present, the fourth parameter is passed on by deparse. +# +# If present and true, it means that the op exists directly as +# part of a lineseq. Currently it's only used by pp_scope to +# decide whether its results need to be enclosed in a do {} block. + # Nonprinting characters with special meaning: # \cS - steal parens (see maybe_parens_unop) # \n - newline and indent @@ -291,7 +299,6 @@ sub begin_is_use { return unless $self->const_sv($constop)->PV eq $module; $constop = $constop->sibling; - $version = $self->const_sv($constop)->int_value; $constop = $constop->sibling; return if $constop->name ne "method_named"; @@ -310,18 +317,18 @@ sub begin_is_use { # See if there are import arguments my $args = ''; - my $constop = $entersub->first->sibling; # Skip over pushmark - return unless $self->const_sv($constop)->PV eq $module; + my $svop = $entersub->first->sibling; # Skip over pushmark + return unless $self->const_sv($svop)->PV eq $module; # Pull out the arguments - for ($constop=$constop->sibling; $constop->name eq "const"; - $constop = $constop->sibling) { + for ($svop=$svop->sibling; $svop->name ne "method_named"; + $svop = $svop->sibling) { $args .= ", " if length($args); - $args .= $self->deparse($constop, 6); + $args .= $self->deparse($svop, 6); } my $use = 'use'; - my $method_named = $constop; + my $method_named = $svop; return if $method_named->name ne "method_named"; my $method_name = $self->const_sv($method_named)->PV; @@ -642,11 +649,14 @@ sub ambient_pragmas { sub deparse { my $self = shift; - my($op, $cx) = @_; + my($op, $cx, $flags) = @_; Carp::confess("Null op in deparse") if !defined($op) || class($op) eq "NULL"; my $meth = "pp_" . $op->name; + if ($meth eq "pp_scope") { + return $self->pp_scope($op, $cx, $flags); + } return $self->$meth($op, $cx); } @@ -971,14 +981,19 @@ sub lineseq { last; } } - if (!is_state $ops[$i] and $ops[$i+1] and !null($ops[$i+1]) and - $ops[$i+1]->name eq "leaveloop" and $self->{'expand'} < 3) + if (!is_state $ops[$i] and (my $ls = $ops[$i+1]) and + !null($ops[$i+1]) and $ops[$i+1]->name eq "lineseq") { - push @exprs, $expr . $self->for_loop($ops[$i], 0); - $i++; - next; + if ($ls->first && !null($ls->first) && is_state($ls->first) + && (my $sib = $ls->first->sibling)) { + if (!null($sib) && $sib->name eq "leaveloop") { + push @exprs, $expr . $self->for_loop($ops[$i], 0); + $i++; + next; + } + } } - $expr .= $self->deparse($ops[$i], 0); + $expr .= $self->deparse($ops[$i], 0, (@ops != 1)); $expr =~ s/;\n?\z//; push @exprs, $expr; } @@ -1024,20 +1039,10 @@ sub scopeop { } } -sub invoker { - my $caller = (caller(2))[3]; - if ($caller eq "B::Deparse::deparse") { - return (caller(3))[3]; - } - else { - return $caller; - } -} - sub pp_scope { - my ($self, $op, $cx) = @_; + my ($self, $op, $cx, $flags) = @_; my $body = scopeop(0, @_); - return $body if $cx > 0 || invoker() ne "B::Deparse::lineseq"; + return $body if $cx > 0 || !defined $flags || !$flags; return "do {\n\t$body\n\b};"; } sub pp_lineseq { scopeop(0, @_); } @@ -1090,6 +1095,7 @@ sub lex_in_scope { my ($self, $name) = @_; $self->populate_curcvlex() if !defined $self->{'curcvlex'}; + return 0 if !defined($self->{'curcop'}); my $seq = $self->{'curcop'}->cop_seq; return 0 if !exists $self->{'curcvlex'}{$name}; for my $a (@{$self->{'curcvlex'}{$name}}) { @@ -1215,10 +1221,10 @@ sub pp_nextstate { sub declare_warnings { my ($from, $to) = @_; - if ($to eq warnings::bits("all")) { + if (($to & WARN_MASK) eq warnings::bits("all")) { return "use warnings;\n"; } - elsif ($to eq "\0"x12) { + elsif (($to & WARN_MASK) eq "\0"x length($to)) { return "no warnings;\n"; } return "BEGIN {\${^WARNING_BITS} = ".cstring($to)."}\n"; @@ -2082,12 +2088,21 @@ sub indirop { $indir = $indir->first; # skip rv2gv if (is_scope($indir)) { $indir = "{" . $self->deparse($indir, 0) . "}"; + } elsif ($indir->name eq "const" && $indir->private & OPpCONST_BARE) { + $indir = $self->const_sv($indir)->PV; } else { $indir = $self->deparse($indir, 24); } $indir = $indir . " "; $kid = $kid->sibling; } + if ($name eq "sort" && $op->private & (OPpSORT_NUMERIC | OPpSORT_INTEGER)) { + $indir = ($op->private & OPpSORT_REVERSE) ? '{$b <=> $a} ' + : '{$a <=> $b} '; + } + elsif ($name eq "sort" && $op->private & OPpSORT_REVERSE) { + $indir = '{$b cmp $a} '; + } for (; !null($kid); $kid = $kid->sibling) { $expr = $self->deparse($kid, 6); push @exprs, $expr; @@ -2284,7 +2299,7 @@ sub loop_common { # block (or the last in a bare loop). my $cont_start = $enter->nextop; my $cont; - if ($$cont_start != $$op and $ {$cont_start->sibling} != $ {$body->last}) { + if ($$cont_start != $$op && ${$cont_start->sibling} != ${$body->last}) { if ($bare) { $cont = $body->last; } else { @@ -2309,6 +2324,9 @@ sub loop_common { } } else { return "" if !defined $body; + if (length $init) { + $head = "for ($init; $cond;) "; + } $cont = "\cK"; $body = $self->deparse($body, 0); } @@ -2327,7 +2345,7 @@ sub for_loop { my $self = shift; my($op, $cx) = @_; my $init = $self->deparse($op, 1); - return $self->loop_common($op->sibling, $cx, $init); + return $self->loop_common($op->sibling->first->sibling, $cx, $init); } sub pp_leavetry { diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm index 8d53136ea7..afe8b27596 100644 --- a/ext/IO/lib/IO/Socket.pm +++ b/ext/IO/lib/IO/Socket.pm @@ -112,7 +112,7 @@ sub connect { $blocking = $sock->blocking(0) if $timeout; if (!connect($sock, $addr)) { - if ($timeout && $!{EINPROGRESS}) { + if (defined $timeout && $!{EINPROGRESS}) { require IO::Select; my $sel = new IO::Select $sock; @@ -168,7 +168,7 @@ sub accept { my $new = $pkg->new(Timeout => $timeout); my $peer = undef; - if($timeout) { + if(defined $timeout) { require IO::Select; my $sel = new IO::Select $sock; @@ -369,13 +369,21 @@ in attempt to make the interface more flexible. These are =item accept([PKG]) -perform the system call C<accept> on the socket and return a new object. The -new object will be created in the same class as the listen socket, unless -C<PKG> is specified. This object can be used to communicate with the client -that was trying to connect. In a scalar context the new socket is returned, -or undef upon failure. In a list context a two-element array is returned -containing the new socket and the peer address; the list will -be empty upon failure. +perform the system call C<accept> on the socket and return a new +object. The new object will be created in the same class as the listen +socket, unless C<PKG> is specified. This object can be used to +communicate with the client that was trying to connect. + +In a scalar context the new socket is returned, or undef upon +failure. In a list context a two-element array is returned containing +the new socket and the peer address; the list will be empty upon +failure. + +The timeout in the [PKG] can be specified as zero to effect a "poll", +but you shouldn't do that because a new IO::Select object will be +created behind the scenes just do to the single poll. This is +horrendously inefficient. Use rather true select() with a zero +timeout on the handle, or non-blocking IO. =item socketpair(DOMAIN, TYPE, PROTOCOL) diff --git a/ext/PerlIO/Scalar/Scalar.xs b/ext/PerlIO/Scalar/Scalar.xs index 86746157a6..f22193e31d 100644 --- a/ext/PerlIO/Scalar/Scalar.xs +++ b/ext/PerlIO/Scalar/Scalar.xs @@ -38,7 +38,10 @@ PerlIOScalar_pushed(PerlIO *f, const char *mode, SV *arg) s->var = newSVpvn("",0); } sv_upgrade(s->var,SVt_PV); - s->posn = 0; + if (strnEQ(mode,"a",1)) + s->posn = SvCUR(SvRV(arg)); + else + s->posn = 0; return PerlIOBase_pushed(f,mode,Nullsv); } @@ -108,7 +111,7 @@ PerlIOScalar_unread(PerlIO *f, const void *vbuf, Size_t count) dTHX; PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); char *dst = SvGROW(s->var,s->posn+count); - Move(vbuf,dst,count,char); + Move(vbuf,dst+s->posn,count,char); s->posn += count; SvCUR_set(s->var,s->posn); SvPOK_on(s->var); diff --git a/global.sym b/global.sym index 08f3d5e48c..f54a3fca08 100644 --- a/global.sym +++ b/global.sym @@ -153,6 +153,7 @@ Perl_hv_undef Perl_ibcmp Perl_ibcmp_locale Perl_init_stacks +Perl_init_tm Perl_instr Perl_is_uni_alnum Perl_is_uni_alnumc @@ -221,6 +222,7 @@ Perl_mg_length Perl_mg_magical Perl_mg_set Perl_mg_size +Perl_mini_mktime Perl_moreswitches Perl_my_atof Perl_my_bcopy @@ -236,6 +238,7 @@ Perl_my_popen Perl_my_popen_list Perl_my_setenv Perl_my_stat +Perl_my_strftime Perl_my_swap Perl_my_htonl Perl_my_ntohl diff --git a/hints/hpux.sh b/hints/hpux.sh index da481dac38..5254258594 100644 --- a/hints/hpux.sh +++ b/hints/hpux.sh @@ -83,6 +83,11 @@ case `$cc -v 2>&1`"" in *) ccisgcc='' ccversion=`which cc | xargs what | awk '/Compiler/{print $2}'` ccflags="-Ae $cc_cppflags" + # Needed because cpp does only support -Aa (not -Ae) + cpplast='-' + cppminus='-' + cppstdin='cc -E -Aa -D__STDC_EXT__' + cpprun=$cppstdin case "$d_casti32" in "") d_casti32='undef' ;; esac @@ -201,7 +206,7 @@ case "$ccisgcc" in *) # HP's compiler cannot combine -g and -O case "$optimize" in - "") optimize="-O" ;; + "") optimize="+O2 +Onolimit" ;; *O[3456789]*) optimize=`echo "$optimize" | sed -e 's/O[3-9]/O2/'` ;; esac ld=/usr/bin/ld diff --git a/installperl b/installperl index 4a77415d91..c35482db93 100755 --- a/installperl +++ b/installperl @@ -393,6 +393,19 @@ if (! $versiononly && (-f 'cppstdin') && (! samepath($installbin, '.'))) { chmod(0755, "$installbin/cppstdin"); } +sub script_alias { + my ($installscript, $orig, $alias, $scr_ext) = @_; + + safe_unlink("$installscript/pstruct$scr_ext"); + if ($^O eq 'dos' or $Is_VMS or $^O eq 'transit') { + copy("$installscript/$orig$scr_ext", + "$installscript/$alias$scr_ext"); + } else { + link("$installscript/$orig$scr_ext", + "$installscript/$alias$scr_ext"); + } +} + if (! $versiononly) { # Install scripts. @@ -405,14 +418,10 @@ if (! $versiononly) { } # pstruct should be a link to c2ph - safe_unlink("$installscript/pstruct$scr_ext"); - if ($^O eq 'dos' or $Is_VMS or $^O eq 'transit') { - copy("$installscript/c2ph$scr_ext", - "$installscript/pstruct$scr_ext"); - } else { - link("$installscript/c2ph$scr_ext", - "$installscript/pstruct$scr_ext"); - } + script_alias('c2ph', 'pstruct'); + + # psed should be a link to s2p + script_alias('s2p', 'psed'); } # Install pod pages. Where? I guess in $installprivlib/pod diff --git a/intrpvar.h b/intrpvar.h index 8ecd10ffed..d2f8e73c2b 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -362,9 +362,9 @@ PERLVARI(Inumeric_standard, bool, TRUE) /* Assume simple numerics */ PERLVARI(Inumeric_local, bool, TRUE) /* Assume local numerics */ -PERLVAR(Inumeric_radix, SV *) - /* The radix separator if not '.' */ +PERLVAR(Inumeric_compat1, char) + /* Used to be numeric_radix */ #endif /* !USE_LOCALE_NUMERIC */ /* utf8 character classes */ @@ -464,9 +464,16 @@ PERLVAR(Ixpvlv_arenaroot,XPVLV*) /* list of allocated xpvlv areas */ PERLVAR(Ixpvbm_arenaroot,XPVBM*) /* list of allocated xpvbm areas */ PERLVAR(Ihe_arenaroot, XPV*) /* list of allocated he areas */ + /* 5.6.0 stopped here */ + PERLVAR(Ipsig_pend, int *) /* per-signal "count" of pending */ PERLVARI(Isig_pending, int,0) /* Number if highest signal pending */ +#ifdef USE_LOCALE_NUMERIC + +PERLVAR(Inumeric_radix_sv, SV *) /* The radix separator if not '.' */ + +#endif /* New variables must be added to the very end for binary compatibility. * XSUB.h provides wrapper functions via perlapi.h that make this diff --git a/lib/NEXT.pm b/lib/NEXT.pm new file mode 100644 index 0000000000..144b145729 --- /dev/null +++ b/lib/NEXT.pm @@ -0,0 +1,140 @@ +package NEXT; +use Carp; +use strict; + +sub ancestors +{ + my @inlist = @_; + my @outlist = (); + while (@inlist) { + push @outlist, shift @inlist; + no strict 'refs'; + unshift @inlist, @{"$outlist[-1]::ISA"}; + } + return @outlist; +} + +sub AUTOLOAD +{ + my ($self) = @_; + my $caller = (caller(1))[3]; + my $wanted = $NEXT::AUTOLOAD || 'NEXT::AUTOLOAD'; + undef $NEXT::AUTOLOAD; + my ($caller_class, $caller_method) = $caller =~ m{(.*)::(.*)}g; + my ($wanted_class, $wanted_method) = $wanted =~ m{(.*)::(.*)}g; + croak "Can't call $wanted from $caller" + unless $caller_method eq $wanted_method; + + local $NEXT::NEXT{$self,$wanted_method} = + $NEXT::NEXT{$self,$wanted_method}; + + unless (@{$NEXT::NEXT{$self,$wanted_method}||[]}) { + my @forebears = ancestors ref $self; + while (@forebears) { + last if shift @forebears eq $caller_class + } + no strict 'refs'; + @{$NEXT::NEXT{$self,$wanted_method}} = + map { *{"${_}::$caller_method"}{CODE}||() } @forebears; + @{$NEXT::NEXT{$self,$wanted_method}} = + map { *{"${_}::AUTOLOAD"}{CODE}||() } @forebears + unless @{$NEXT::NEXT{$self,$wanted_method}}; + } + $wanted_method = shift @{$NEXT::NEXT{$self,$wanted_method}}; + return shift()->$wanted_method(@_) if $wanted_method; + return; +} + +1; + +__END__ + +=head1 NAME + +NEXT.pm - Provide a pseudo-class NEXT that allows method redispatch + + +=head1 SYNOPSIS + + use NEXT; + + package A; + sub A::method { print "$_[0]: A method\n"; $_[0]->NEXT::method() } + sub A::DESTROY { print "$_[0]: A dtor\n"; $_[0]->NEXT::DESTROY() } + + package B; + use base qw( A ); + sub B::AUTOLOAD { print "$_[0]: B AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() } + sub B::DESTROY { print "$_[0]: B dtor\n"; $_[0]->NEXT::DESTROY() } + + package C; + sub C::method { print "$_[0]: C method\n"; $_[0]->NEXT::method() } + sub C::AUTOLOAD { print "$_[0]: C AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() } + sub C::DESTROY { print "$_[0]: C dtor\n"; $_[0]->NEXT::DESTROY() } + + package D; + use base qw( B C ); + sub D::method { print "$_[0]: D method\n"; $_[0]->NEXT::method() } + sub D::AUTOLOAD { print "$_[0]: D AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() } + sub D::DESTROY { print "$_[0]: D dtor\n"; $_[0]->NEXT::DESTROY() } + + package main; + + my $obj = bless {}, "D"; + + $obj->method(); # Calls D::method, A::method, C::method + $obj->missing_method(); # Calls D::AUTOLOAD, B::AUTOLOAD, C::AUTOLOAD + + # Clean-up calls D::DESTROY, B::DESTROY, A::DESTROY, C::DESTROY + + +=head1 DESCRIPTION + +NEXT.pm adds a pseudoclass named C<NEXT> to any program +that uses it. If a method C<m> calls C<$self->NEXT::m()>, the call to +C<m> is redispatched as if the calling method had not originally been found. + +In other words, a call to C<$self->NEXT::m()> resumes the depth-first, +left-to-right search of parent classes that resulted in the original +call to C<m>. + +A typical use would be in the destructors of a class hierarchy, +as illustrated in the synopsis above. Each class in the hierarchy +has a DESTROY method that performs some class-specific action +and then redispatches the call up the hierarchy. As a result, +when an object of class D is destroyed, the destructors of I<all> +its parent classes are called (in depth-first, left-to-right order). + +Another typical use of redispatch would be in C<AUTOLOAD>'ed methods. +If such a method determined that it was not able to handle a +particular call, it might choose to redispatch that call, in the +hope that some other C<AUTOLOAD> (above it, or to its left) might +do better. + +Note that it is a fatal error for any method (including C<AUTOLOAD>) +to attempt to redispatch any method except itself. For example: + + sub D::oops { print "oops!\n"; $_[0]->NEXT::other_method() } + + +=head1 AUTHOR + +Damian Conway (damian@conway.org) + +=head1 BUGS AND IRRITATIONS + +Because it's a module, not an integral part of the interpreter, NEXT.pm +has to guess where the surrounding call was found in the method +look-up sequence. In the presence of diamond inheritance patterns +it occasionally guesses wrong. + +It's also too slow (despite caching). + +Comment, suggestions, and patches welcome. + +=head1 COPYRIGHT + + Copyright (c) 2000, Damian Conway. All Rights Reserved. + This module is free software. It may be used, redistributed +and/or modified under the terms of the Perl Artistic License + (see http://www.perl.com/perl/misc/Artistic.html) diff --git a/lib/Switch.pm b/lib/Switch.pm index 1b84371a10..2a3093c359 100644 --- a/lib/Switch.pm +++ b/lib/Switch.pm @@ -4,7 +4,7 @@ use strict; use vars qw($VERSION); use Carp; -$VERSION = '2.01'; +$VERSION = '2.02'; # LOAD FILTERING MODULE... @@ -18,10 +18,10 @@ $::_S_W_I_T_C_H = sub { croak "case statement not in switch block" }; my $offset; my $fallthrough; -my $nextlabel = 1; sub import { + $DB::single = 1; $fallthrough = grep /\bfallthrough\b/, @_; $offset = (caller)[2]+1; filter_add({}) unless @_>1 && $_[1] ne '__'; @@ -80,7 +80,7 @@ sub filter_blocks my $text = ""; component: while (pos $source < length $source) { - if ($source =~ m/(\G\s*use\s+switch\b)/gc) + if ($source =~ m/(\G\s*use\s+Switch\b)/gc) { $text .= q{use Switch 'noimport'}; next component; @@ -88,20 +88,20 @@ sub filter_blocks my @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,1); if (defined $pos[0]) { - $text .= substr($source,$pos[2],$pos[18]-$pos[2]); + $text .= " " . substr($source,$pos[2],$pos[18]-$pos[2]); next component; } @pos = Text::Balanced::_match_variable(\$source,qr/\s*/); if (defined $pos[0]) { - $text .= substr($source,$pos[0],$pos[4]-$pos[0]); + $text .= " " . substr($source,$pos[0],$pos[4]-$pos[0]); next component; } if ($source =~ m/\G(\n*)(\s*)switch\b(?=\s*[(])/gc) { $text .= $1.$2.'S_W_I_T_C_H: while (1) '; - @pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\(/,qr/\)/,qr/\{/,qr/\}/,undef) + @pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\(/,qr/\)/,qr/[[{(<]/,qr/[]})>]/,undef) or do { die "Bad switch statement (problem in the parentheses?) near $Switch::file line ", line(substr($source,0,pos $source),$line), "\n"; }; @@ -454,8 +454,8 @@ Switch - A switch statement for Perl =head1 VERSION -This document describes version 2.01 of Switch, -released January 9, 2001. +This document describes version 2.02 of Switch, +released April 26, 2001. =head1 SYNOPSIS diff --git a/patchlevel.h b/patchlevel.h index fc213131ce..d7ee800e21 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -70,7 +70,7 @@ #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { NULL - ,"DEVEL9884" + ,"DEVEL9916" ,NULL }; @@ -585,7 +585,7 @@ perl_destruct(pTHXx) #ifdef USE_LOCALE_NUMERIC Safefree(PL_numeric_name); PL_numeric_name = Nullch; - SvREFCNT_dec(PL_numeric_radix); + SvREFCNT_dec(PL_numeric_radix_sv); #endif /* clear utf8 character classes */ @@ -2615,6 +2615,9 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript) sv_catpvn(sv, "-I", 2); sv_catpv(sv,PRIVLIB_EXP); + DEBUG_P(PerlIO_printf(Perl_debug_log, + "PL_preprocess: scriptname=\"%s\", cpp=\"%s\", sv=\"%s\", CPPMINUS=\"%s\"\n", + scriptname, SvPVX (cpp), SvPVX (sv), CPPMINUS)); #if defined(MSDOS) || defined(WIN32) Perl_sv_setpvf(aTHX_ cmd, "\ sed %s -e \"/^[^#]/b\" \ @@ -3336,7 +3336,7 @@ typedef struct am_table_short AMTS; #define IS_NUMERIC_RADIX(s) \ ((PL_hints & HINT_LOCALE) && \ - PL_numeric_radix && memEQ(s, SvPVX(PL_numeric_radix), SvCUR(PL_numeric_radix))) + PL_numeric_radix_sv && memEQ(s, SvPVX(PL_numeric_radix_sv), SvCUR(PL_numeric_radix_sv))) #define STORE_NUMERIC_LOCAL_SET_STANDARD() \ bool was_local = (PL_hints & HINT_LOCALE) && PL_numeric_local; \ @@ -1097,6 +1097,13 @@ Perl_init_stacks(pTHXo) ((CPerlObj*)pPerl)->Perl_init_stacks(); } +#undef Perl_init_tm +void +Perl_init_tm(pTHXo_ struct tm *ptm) +{ + ((CPerlObj*)pPerl)->Perl_init_tm(ptm); +} + #undef Perl_instr char* Perl_instr(pTHXo_ const char* big, const char* little) @@ -1588,6 +1595,13 @@ Perl_mg_size(pTHXo_ SV* sv) return ((CPerlObj*)pPerl)->Perl_mg_size(sv); } +#undef Perl_mini_mktime +void +Perl_mini_mktime(pTHXo_ struct tm *pm) +{ + ((CPerlObj*)pPerl)->Perl_mini_mktime(pm); +} + #undef Perl_moreswitches char* Perl_moreswitches(pTHXo_ char* s) @@ -1706,6 +1720,13 @@ Perl_my_stat(pTHXo) { return ((CPerlObj*)pPerl)->Perl_my_stat(); } + +#undef Perl_my_strftime +char * +Perl_my_strftime(pTHXo_ char *fmt, int sec, int min, int hour, int mday, int mon, int year, int wday, int yday, int isdst) +{ + return ((CPerlObj*)pPerl)->Perl_my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst); +} #if defined(MYSWAP) #undef Perl_my_swap @@ -3329,9 +3350,9 @@ Perl_swash_init(pTHXo_ char* pkg, char* name, SV* listsv, I32 minbits, I32 none) #undef Perl_swash_fetch UV -Perl_swash_fetch(pTHXo_ SV *sv, U8 *ptr) +Perl_swash_fetch(pTHXo_ SV *sv, U8 *ptr, bool do_utf8) { - return ((CPerlObj*)pPerl)->Perl_swash_fetch(sv, ptr); + return ((CPerlObj*)pPerl)->Perl_swash_fetch(sv, ptr, do_utf8); } #undef Perl_taint_env @@ -390,12 +390,14 @@ START_EXTERN_C #define PL_nthreads_cond (*Perl_Inthreads_cond_ptr(aTHXo)) #undef PL_nullstash #define PL_nullstash (*Perl_Inullstash_ptr(aTHXo)) +#undef PL_numeric_compat1 +#define PL_numeric_compat1 (*Perl_Inumeric_compat1_ptr(aTHXo)) #undef PL_numeric_local #define PL_numeric_local (*Perl_Inumeric_local_ptr(aTHXo)) #undef PL_numeric_name #define PL_numeric_name (*Perl_Inumeric_name_ptr(aTHXo)) -#undef PL_numeric_radix -#define PL_numeric_radix (*Perl_Inumeric_radix_ptr(aTHXo)) +#undef PL_numeric_radix_sv +#define PL_numeric_radix_sv (*Perl_Inumeric_radix_sv_ptr(aTHXo)) #undef PL_numeric_standard #define PL_numeric_standard (*Perl_Inumeric_standard_ptr(aTHXo)) #undef PL_ofmt @@ -772,6 +774,8 @@ START_EXTERN_C #define PL_regcomp_parse (*Perl_Tregcomp_parse_ptr(aTHXo)) #undef PL_regcomp_rx #define PL_regcomp_rx (*Perl_Tregcomp_rx_ptr(aTHXo)) +#undef PL_regcompat1 +#define PL_regcompat1 (*Perl_Tregcompat1_ptr(aTHXo)) #undef PL_regcompp #define PL_regcompp (*Perl_Tregcompp_ptr(aTHXo)) #undef PL_regdata @@ -808,8 +812,6 @@ START_EXTERN_C #define PL_regnpar (*Perl_Tregnpar_ptr(aTHXo)) #undef PL_regprecomp #define PL_regprecomp (*Perl_Tregprecomp_ptr(aTHXo)) -#undef PL_regprev -#define PL_regprev (*Perl_Tregprev_ptr(aTHXo)) #undef PL_regprogram #define PL_regprogram (*Perl_Tregprogram_ptr(aTHXo)) #undef PL_regsawback @@ -2187,13 +2187,13 @@ IV PerlIOStdio_close(PerlIO *f) { dTHX; -#ifdef HAS_SOCKS5_INIT +#ifdef SOCKS5_VERSION_NAME int optval; Sock_size_t optlen = sizeof(int); #endif FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio; return( -#ifdef HAS_SOCKS5_INIT +#ifdef SOCKS5_VERSION_NAME (getsockopt(PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (void *)&optval, &optlen) < 0) ? PerlSIO_fclose(stdio) : close(PerlIO_fileno(f)) diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 491e484ca8..af5a1bc803 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -532,7 +532,7 @@ Found in file gv.h Returns the glob with the given C<name> and a defined subroutine or C<NULL>. The glob lives in the given C<stash>, or in the stashes -accessible via @ISA and @UNIVERSAL. +accessible via @ISA and UNIVERSAL::. The argument C<level> should be either 0 or -1. If C<level==0>, as a side-effect creates a glob with the given C<name> in the given C<stash> @@ -2408,19 +2408,19 @@ false, defined or undefined. Does not handle 'get' magic. =for hackers Found in file sv.h -=item svtype +=item SvTYPE -An enum of flags for Perl types. These are found in the file B<sv.h> -in the C<svtype> enum. Test these flags with the C<SvTYPE> macro. +Returns the type of the SV. See C<svtype>. + + svtype SvTYPE(SV* sv) =for hackers Found in file sv.h -=item SvTYPE - -Returns the type of the SV. See C<svtype>. +=item svtype - svtype SvTYPE(SV* sv) +An enum of flags for Perl types. These are found in the file B<sv.h> +in the C<svtype> enum. Test these flags with the C<SvTYPE> macro. =for hackers Found in file sv.h diff --git a/pod/perldata.pod b/pod/perldata.pod index 42e3af723c..b7c3b1cecd 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -278,17 +278,10 @@ integer formats: 0377 # octal 0b011011 # binary -You are allowed to use underscores (underbars) in numeric literals for -legibility, as long as the underscores are spaced at least one digit -apart, and they do not begin or end the integer or fractional part. -You could, for example, group binary digits by threes (as for -a Unix-style mode argument such as 0b110_100_100) or by fours -(to represent nibbles, as in 0b1010_0110) or in other groups. - -(Note that if you try to begin a number with an underscore, it won't -even be understood as a number, it will be understood as a bareword, -which depending on the context may mean for example a string constant, -a function call, or a filehandle.) +You are allowed to use underscores (underbars) in numeric literals +between digits for legibility. You could, for example, group binary +digits by threes (as for a Unix-style mode argument such as 0b110_100_100) +or by fours (to represent nibbles, as in 0b1010_0110) or in other groups. String literals are usually delimited by either single or double quotes. They work much like quotes in the standard Unix shells: diff --git a/pod/perldiag.pod b/pod/perldiag.pod index e09df2bfb4..eab05567e3 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1872,10 +1872,8 @@ ended earlier on the current line. =item Misplaced _ in number -(W syntax) An underscore (underbar) in a numeric constant either -immediately followed an earlier underscore, or an underscore began or -ended a numeric constant, or its fractional part (in the case of -decimal constants) began or ended with an underscore. +(W syntax) An underscore (underbar) in a numeric constant did not +separate two digits. =item Missing %sbrace%s on \N{} diff --git a/pod/perlfaq.pod b/pod/perlfaq.pod index bc29c694f2..3f5536b7fc 100644 --- a/pod/perlfaq.pod +++ b/pod/perlfaq.pod @@ -692,6 +692,10 @@ I still don't get locking. I just want to increment the number in the file. Ho =item * +All I want to do is append a small amount of text to the end of a file. Do I still have to use locking? + +=item * + How do I randomly update a binary file? =item * diff --git a/pod/perlfaq5.pod b/pod/perlfaq5.pod index 7491baaac7..dde1feac4d 100644 --- a/pod/perlfaq5.pod +++ b/pod/perlfaq5.pod @@ -723,6 +723,34 @@ Here's a much better web-page hit counter: If the count doesn't impress your friends, then the code might. :-) +=head2 All I want to do is append a small amount of text to the end of a file. Do I still have to use locking? + +If you are on a system that correctly implements flock() and you use the +example appending code from "perldoc -f flock" everything will be OK +even if the OS you are on doesn't implement append mode correctly (if +such a system exists.) So if you are happy to restrict yourself to OSs +that implement flock() (and that's not really much of a restriction) +then that is what you should do. + +If you know you are only going to use a system that does correctly +implement appending (i.e. not Win32) then you can omit the seek() from +the above code. + +If you know you are only writing code to run on an OS and filesystem that +does implement append mode correctly (a local filesystem on a modern +Unix for example), and you keep the file in block-buffered mode and you +write less than one buffer-full of output between each manual flushing +of the buffer then each bufferload is almost garanteed to be written to +the end of the file in one chunk without getting intermingled with +anyone else's output. You can also use the syswrite() function which is +simply a wrapper around your systems write(2) system call. + +There is still a small theoretical chance that a signal will interrupt +the system level write() operation before completion. There is also a +possibility that some STDIO implementations may call multiple system +level write()s even if the buffer was empty to start. There may be some +systems where this probability is reduced to zero. + =head2 How do I randomly update a binary file? If you're just trying to patch a binary, in many cases something as diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 4e7f1a940e..b97c4a896e 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -3509,6 +3509,13 @@ than the value of EXPR. (EXPR should be positive.) If EXPR is omitted, the value C<1> is used. Automatically calls C<srand> unless C<srand> has already been called. See also C<srand>. +Apply C<int()> to the value returned by C<rand()> if you want random +integers instead of random fractional numbers. For example, + + int(rand(10)) + +returns a random integer between C<0> and C<9>, inclusive. + (Note: If your rand function consistently returns numbers that are too large or too small, then your version of Perl was probably compiled with the wrong number of RANDBITS.) diff --git a/pod/perlobj.pod b/pod/perlobj.pod index f31ce2c993..e466dc7dd7 100644 --- a/pod/perlobj.pod +++ b/pod/perlobj.pod @@ -361,21 +361,41 @@ are inherited by all other classes: C<isa> returns I<true> if its object is blessed into a subclass of C<CLASS> -You can also call C<UNIVERSAL::isa> as a sub with two arguments. The -first does not need to be an object or even a reference. This -allows the ability to check what a reference points to, or whether +You can also call C<UNIVERSAL::isa> as a subroutine with two arguments. +The first does not need to be an object or even a reference. This +allows you to check what a reference points to, or whether something is a reference of a given type. Example if(UNIVERSAL::isa($ref, 'ARRAY')) { #... } +To determine if a reference is a blessed object, you can write + + print "It's an object\n" if UNIVERSAL::isa($val, 'UNIVERSAL'); + =item can(METHOD) C<can> checks to see if its object has a method called C<METHOD>, if it does then a reference to the sub is returned, if it does not then I<undef> is returned. +C<UNIVERSAL::can> can also be called as a subroutine with two arguments. +It'll always return I<undef> if its first argument isn't an object or a +class name. So here's another way to check if a reference is a +blessed object + + print "It's still an object\n" if UNIVERSAL::can($val, 'can'); + +You can also use the C<blessed> function of Scalar::Util: + + use Scalar::Util 'blessed'; + + my $blessing = blessed $suspected_object; + +C<blessed> returns the name of the package the argument has been +blessed into, or C<undef>. + =item VERSION( [NEED] ) C<VERSION> returns the version number of the class (package). If the @@ -4660,7 +4660,6 @@ Perl_save_re_context(pTHX) SAVEVPTR(PL_regendp); /* Ditto for endp. */ SAVEVPTR(PL_reglastparen); /* Similarly for lastparen. */ SAVEPPTR(PL_regtill); /* How far we are required to go. */ - SAVEI8(PL_regprev); /* char before regbol, \n if none */ SAVEGENERICPV(PL_reg_start_tmp); /* from regexec.c */ PL_reg_start_tmp = 0; SAVEI32(PL_reg_start_tmpl); /* from regexec.c */ @@ -946,7 +946,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta /* FALL THROUGH */ case BOUND: if (do_utf8) { - if (s == startpos) + if (s == PL_bostr) tmp = '\n'; else { U8 *r = reghop3((U8*)s, -1, (U8*)startpos); @@ -969,7 +969,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } } else { - tmp = (s != startpos) ? UCHARAT(s - 1) : '\n'; + tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n'; tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0); while (s < strend) { if (tmp == @@ -989,7 +989,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta /* FALL THROUGH */ case NBOUND: if (do_utf8) { - if (s == startpos) + if (s == PL_bostr) tmp = '\n'; else { U8 *r = reghop3((U8*)s, -1, (U8*)startpos); @@ -1010,7 +1010,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta } } else { - tmp = (s != startpos) ? UCHARAT(s - 1) : '\n'; + tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n'; tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0); while (s < strend) { @@ -1429,19 +1429,6 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * if (strend - startpos < minlen) goto phooey; } - if (startpos == strbeg) /* is ^ valid at stringarg? */ - PL_regprev = '\n'; - else { - if (prog->reganch & ROPT_UTF8 && do_utf8) { - U8 *s = reghop3((U8*)stringarg, -1, (U8*)strbeg); - PL_regprev = utf8n_to_uvchr(s, (U8*)stringarg - s, NULL, 0); - } - else - PL_regprev = (U32)stringarg[-1]; - if (!PL_multiline && PL_regprev == '\n') - PL_regprev = '\0'; /* force ^ to NOT match */ - } - /* Check validity of program. */ if (UCHARAT(prog->program) != REG_MAGIC) { Perl_croak(aTHX_ "corrupted regexp program"); @@ -2044,19 +2031,16 @@ S_regmatch(pTHX_ regnode *prog) switch (OP(scan)) { case BOL: - if (locinput == PL_bostr - ? PL_regprev == '\n' - : (PL_multiline && - (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') ) + if (locinput == PL_bostr || (PL_multiline && + (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') ) { /* regtill = regbol; */ break; } sayNO; case MBOL: - if (locinput == PL_bostr - ? PL_regprev == '\n' - : ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n') ) + if (locinput == PL_bostr || + ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n')) { break; } @@ -2259,8 +2243,8 @@ S_regmatch(pTHX_ regnode *prog) case NBOUND: /* was last char in word? */ if (do_utf8) { - if (locinput == PL_regbol) - ln = PL_regprev; + if (locinput == PL_bostr) + ln = '\n'; else { U8 *r = reghop((U8*)locinput, -1); @@ -2277,8 +2261,8 @@ S_regmatch(pTHX_ regnode *prog) } } else { - ln = (locinput != PL_regbol) ? - UCHARAT(locinput - 1) : PL_regprev; + ln = (locinput != PL_bostr) ? + UCHARAT(locinput - 1) : '\n'; if (OP(scan) == BOUND || OP(scan) == NBOUND) { ln = isALNUM(ln); n = isALNUM(nextchr); @@ -2533,7 +2533,7 @@ Perl_looks_like_number(pTHX_ SV *sv) ) { #ifdef USE_LOCALE_NUMERIC if (specialradix) - s += SvCUR(PL_numeric_radix); + s += SvCUR(PL_numeric_radix_sv); else #endif s++; @@ -2549,7 +2549,7 @@ Perl_looks_like_number(pTHX_ SV *sv) ) { #ifdef USE_LOCALE_NUMERIC if (specialradix) - s += SvCUR(PL_numeric_radix); + s += SvCUR(PL_numeric_radix_sv); else #endif s++; @@ -9081,7 +9081,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_numeric_name = SAVEPV(proto_perl->Inumeric_name); PL_numeric_standard = proto_perl->Inumeric_standard; PL_numeric_local = proto_perl->Inumeric_local; - PL_numeric_radix = sv_dup_inc(proto_perl->Inumeric_radix); + PL_numeric_radix_sv = sv_dup_inc(proto_perl->Inumeric_radix_sv); #endif /* !USE_LOCALE_NUMERIC */ /* utf8 character classes */ @@ -9295,7 +9295,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_regendp = (I32*)NULL; PL_reglastparen = (U32*)NULL; PL_regtill = Nullch; - PL_regprev = '\n'; PL_reg_start_tmp = (char**)NULL; PL_reg_start_tmpl = 0; PL_regdata = (struct reg_data*)NULL; diff --git a/t/io/fflush.t b/t/io/fflush.t new file mode 100644 index 0000000000..8c6bd080a1 --- /dev/null +++ b/t/io/fflush.t @@ -0,0 +1,125 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +# Script to test auto flush on fork/exec/system/qx. The idea is to +# print "Pe" to a file from a parent process and "rl" to the same file +# from a child process. If buffers are flushed appropriately, the +# file should contain "Perl". We'll see... +use Config; +use warnings; +use strict; + +# This attempts to mirror the #ifdef forest found in perl.h so that we +# know when to run these tests. If that forest ever changes, change +# it here too or expect test gratuitous test failures. +if ($Config{useperlio} || $Config{fflushNULL} || $Config{d_sfio}) { + print "1..4\n"; +} else { + if ($Config{fflushall}) { + print "1..4\n"; + } else { + print "1..0 # Skip: fflush(NULL) or equivalent not available\n"; + exit; + } +} + +my $runperl = qq{$^X "-I../lib"}; +my @delete; + +END { + for (@delete) { + unlink $_ or warn "unlink $_: $!"; + } +} + +sub file_eq { + my $f = shift; + my $val = shift; + + open IN, $f or die "open $f: $!"; + chomp(my $line = <IN>); + close IN; + + print "# got $line\n"; + print "# expected $val\n"; + return $line eq $val; +} + +# This script will be used as the command to execute from +# child processes +open PROG, "> ff-prog" or die "open ff-prog: $!"; +print PROG <<'EOF'; +my $f = shift; +my $str = shift; +open OUT, ">> $f" or die "open $f: $!"; +print OUT $str; +close OUT; +EOF + ; +close PROG; +push @delete, "ff-prog"; + +$| = 0; # we want buffered output + +# Test flush on fork/exec +if ($Config{d_fork} ne "define") { + print "ok 1 # skipped: no fork\n"; +} else { + my $f = "ff-fork-$$"; + open OUT, "> $f" or die "open $f: $!"; + print OUT "Pe"; + my $pid = fork; + if ($pid) { + # Parent + wait; + close OUT or die "close $f: $!"; + } elsif (defined $pid) { + # Kid + print OUT "r"; + my $command = qq{$runperl "ff-prog" "$f" "l"}; + print "# $command\n"; + exec $command or die $!; + exit; + } else { + # Bang + die "fork: $!"; + } + + print file_eq($f, "Perl") ? "ok 1\n" : "not ok 1\n"; + push @delete, $f; +} + +# Test flush on system/qx/pipe open +my %subs = ( + "system" => sub { + my $c = shift; + system $c; + }, + "qx" => sub { + my $c = shift; + qx{$c}; + }, + "popen" => sub { + my $c = shift; + open PIPE, "$c|" or die "$c: $!"; + close PIPE; + }, + ); +my $t = 2; +for (qw(system qx popen)) { + my $code = $subs{$_}; + my $f = "ff-$_-$$"; + my $command = qq{$runperl "ff-prog" "$f" "rl"}; + open OUT, "> $f" or die "open $f: $!"; + print OUT "Pe"; + print "# $command\n"; + $code->($command); + close OUT; + print file_eq($f, "Perl") ? "ok $t\n" : "not ok $t\n"; + push @delete, $f; + ++$t; +} diff --git a/t/lib/b-deparse.t b/t/lib/b-deparse.t index 24ff3279b1..59f8cbfb4f 100644 --- a/t/lib/b-deparse.t +++ b/t/lib/b-deparse.t @@ -15,16 +15,13 @@ use warnings; use strict; use Config; -print "1..14\n"; - -my $test = 1; - -sub ok { print "ok $test\n"; $test++ } - +print "1..12\n"; use B::Deparse; my $deparse = B::Deparse->new() or print "not "; -ok; +my $i=1; +print "ok ", $i++, "\n"; + # Tell B::Deparse about our ambient pragmas { my ($hint_bits, $warning_bits); @@ -36,62 +33,63 @@ ok; ); } -print "not " if "{\n 1;\n}" ne $deparse->coderef2text(sub {1}); -ok; +$/ = "\n####\n"; +while (<DATA>) { + chomp; + s/#.*$//mg; -print "not " if "{\n '???';\n 2;\n}" ne - $deparse->coderef2text(sub {1;2}); -ok; - -print "not " if "{\n \$test /= 2 if ++\$test;\n}" ne - $deparse->coderef2text(sub {++$test and $test/=2;}); -ok; + my ($input, $expected); + if (/(.*)\n>>>>\n(.*)/s) { + ($input, $expected) = ($1, $2); + } + else { + ($input, $expected) = ($_, $_); + } -print "not " if "{\n -((1, 2) x 2);\n}" ne - $deparse->coderef2text(sub {-((1,2)x2)}); -ok; + my $coderef = eval "sub {$input}"; -{ -my $a = <<'EOF'; -{ - $test = sub : lvalue { - my $x; + if ($@) { + print "not ok ", $i++, "\n"; + print "# $@"; + } + else { + my $deparsed = $deparse->coderef2text( $coderef ); + my $regex = quotemeta($expected); + do { + no warnings 'misc'; + $regex =~ s/\s+/\s+/g; + }; + + my $ok = ($deparsed =~ /^\{\s*$regex\s*\}$/); + print ($ok ? "ok " : "not ok "); + print $i++, "\n"; + if (!$ok) { + print "# EXPECTED:\n"; + $regex =~ s/^/# /mg; + print "$regex\n"; + + print "\n# GOT: \n"; + $deparsed =~ s/^/# /mg; + print "$deparsed\n"; + } } - ; -} -EOF -chomp $a; -print "not " if $deparse->coderef2text(sub{$test = sub : lvalue{my $x}}) ne $a; -ok; - -$a =~ s/lvalue/method/; -print "not " if $deparse->coderef2text(sub{$test = sub : method{my $x}}) ne $a; -ok; - -$a =~ s/method/locked method/; -print "not " if $deparse->coderef2text(sub{$test = sub : method locked {my $x}}) - ne $a; -ok; } -print "not " if (eval "sub ".$deparse->coderef2text(sub () { 42 }))->() != 42; -ok; - use constant 'c', 'stuff'; print "not " if (eval "sub ".$deparse->coderef2text(\&c))->() ne 'stuff'; -ok; +print "ok ", $i++, "\n"; $a = 0; print "not " if "{\n (-1) ** \$a;\n}" ne $deparse->coderef2text(sub{(-1) ** $a }); -ok; +print "ok ", $i++, "\n"; # XXX ToDo - constsub that returns a reference #use constant cr => ['hello']; #my $string = "sub " . $deparse->coderef2text(\&cr); #my $val = (eval $string)->(); #print "not " if ref($val) ne 'ARRAY' || $val->[0] ne 'hello'; -#ok; +#print "ok ", $i++, "\n"; my $a; my $Is_VMS = $^O eq 'VMS'; @@ -114,19 +112,57 @@ LINE: while (defined($_ = <ARGV>)) { EOF print "# [$a]\n\# vs expected\n# [$b]\nnot " if $a ne $b; -ok; - +print "ok ", $i++, "\n"; -# Bug 20001204.07 +__DATA__ +# 1 +1; +#### +# 2 +{ + no warnings; + '???'; + 2; +} +#### +# 3 +my $test; +++$test and $test /= 2; +>>>> +my $test; +$test /= 2 if ++$test; +#### +# 4 +-((1, 2) x 2); +#### +# 5 +{ + my $test = sub : lvalue { + my $x; + } + ; +} +#### +# 6 +{ + my $test = sub : method { + my $x; + } + ; +} +#### +# 7 +{ + my $test = sub : locked method { + my $x; + } + ; +} +#### +# 8 { -my $foo = $deparse->coderef2text(sub { { 234; }}); -# Constants don't get optimised here. -print "not " unless $foo =~ /{.*{.*234;.*}.*}/sm; -ok; -$foo = $deparse->coderef2text(sub { { 234; } continue { 123; } }); -unless ($foo =~ /{\s*{\s*do\s*{\s*234;\s*};\s*}\s*continue\s*{\s*123;\s*}\s*}/sm) { - print "# [$foo]\n\# vs expected\n# [{ { do { 234; }; } continue { 123; } }]\n"; - print "not "; + 234; } -ok; +continue { + 123; } diff --git a/t/lib/io_scalar.t b/t/lib/io_scalar.t index 3679550dae..928355ecb5 100644 --- a/t/lib/io_scalar.t +++ b/t/lib/io_scalar.t @@ -10,7 +10,7 @@ BEGIN { } $| = 1; -print "1..9\n"; +print "1..11\n"; my $fh; my $var = "ok 2\n"; @@ -32,4 +32,17 @@ print "not " if eof($fh); print "ok 8\n"; print "not " unless <$fh> eq "foo\n"; print "ok 9\n"; - +# Test multiple consecutive writes to $var +$var = ""; +seek($fh, 0, 0); +print $fh "Fred and Wilma "; +print $fh "Flintstone"; +print "not " unless $var eq "Fred and Wilma Flintstone"; +print "ok 10\n"; +# Test appending +close $fh; +$var = "Fred and Wilma "; +open $fh, ">>", \$var; +print $fh "Flintstone"; +print "not " unless $var eq "Fred and Wilma Flintstone"; +print "ok 11\n"; diff --git a/t/lib/mimeqp.t b/t/lib/mimeqp.t index f7e127fd4a..f7e127fd4a 100644..100755 --- a/t/lib/mimeqp.t +++ b/t/lib/mimeqp.t diff --git a/t/lib/next.t b/t/lib/next.t new file mode 100644 index 0000000000..6328fd170c --- /dev/null +++ b/t/lib/next.t @@ -0,0 +1,99 @@ +#! /usr/local/bin/perl -w + + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +BEGIN { print "1..20\n"; } + +use NEXT; + +print "ok 1\n"; + +package A; +sub A::method { return ( 3, $_[0]->NEXT::method() ) } +sub A::DESTROY { $_[0]->NEXT::DESTROY() } + +package B; +use base qw( A ); +sub B::AUTOLOAD { return ( 9, $_[0]->NEXT::AUTOLOAD() ) } +sub B::DESTROY { $_[0]->NEXT::DESTROY() } + +package C; +sub C::DESTROY { print "ok 18\n"; $_[0]->NEXT::DESTROY() } + +package D; +@D::ISA = qw( B C E ); +sub D::method { return ( 2, $_[0]->NEXT::method() ) } +sub D::AUTOLOAD { return ( 8, $_[0]->NEXT::AUTOLOAD() ) } +sub D::DESTROY { print "ok 17\n"; $_[0]->NEXT::DESTROY() } +sub D::oops { $_[0]->NEXT::method() } + +package E; +@E::ISA = qw( F G ); +sub E::method { return ( 4, $_[0]->NEXT::method(), $_[0]->NEXT::method() ) } +sub E::AUTOLOAD { return ( 10, $_[0]->NEXT::AUTOLOAD() ) } +sub E::DESTROY { print "ok 19\n"; $_[0]->NEXT::DESTROY() } + +package F; +sub F::method { return ( 5 ) } +sub F::AUTOLOAD { return ( 11 ) } +sub F::DESTROY { print "ok 20\n" } + +package G; +sub G::method { return ( 6 ) } +sub G::AUTOLOAD { print "not "; return } +sub G::DESTROY { print "not ok 21"; return } + +package main; + +my $obj = bless {}, "D"; + +my @vals; + +# TEST NORMAL REDISPATCH (ok 2..6) +@vals = $obj->method(); +print map "ok $_\n", @vals; + +# RETEST NORMAL REDISPATCH SHOULD BE THE SAME (ok 7) +@vals = $obj->method(); +print "not " unless join("", @vals) == "23456"; +print "ok 7\n"; + +# TEST AUTOLOAD REDISPATCH (ok 8..11) +@vals = $obj->missing_method(); +print map "ok $_\n", @vals; + +# NAMED METHOD CAN'T REDISPATCH TO NAMED METHOD OF DIFFERENT NAME (ok 12) +eval { $obj->oops() } && print "not "; +print "ok 12\n"; + +# AUTOLOAD'ED METHOD CAN'T REDISPATCH TO NAMED METHOD (ok 13) +eval q{ + package C; + sub AUTOLOAD { $_[0]->NEXT::method() }; +}; +eval { $obj->missing_method(); } && print "not "; +print "ok 13\n"; + +# NAMED METHOD CAN'T REDISPATCH TO AUTOLOAD'ED METHOD (ok 14) +eval q{ + package C; + sub method { $_[0]->NEXT::AUTOLOAD() }; +}; +eval { $obj->method(); } && print "not "; +print "ok 14\n"; + +# BASE CLASS METHODS ONLY REDISPATCHED WITHIN HIERARCHY (ok 15..16) +my $ob2 = bless {}, "B"; +@val = $ob2->method(); +print "not " unless @val==1 && $val[0]==3; +print "ok 15\n"; + +@val = $ob2->missing_method(); +print "not " unless @val==1 && $val[0]==9; +print "ok 16\n"; + +# CAN REDISPATCH DESTRUCTORS (ok 17..20) diff --git a/t/lib/selfstubber.t b/t/lib/selfstubber.t index fd0cf0640e..2e74a022d6 100644 --- a/t/lib/selfstubber.t +++ b/t/lib/selfstubber.t @@ -10,6 +10,10 @@ use Devel::SelfStubber; my $runperl = "$^X \"-I../lib\""; +# ensure correct output ordering for system() calls + +select STDERR; $| = 1; select STDOUT; $| = 1; + print "1..12\n"; my @cleanup; @@ -199,11 +203,11 @@ print "ok 8\n"; } # Check that the DATA handle stays open -system "$runperl -w \"-I$lib\" -MData -e Data::ok"; +system "$runperl -w \"-I$lib\" \"-MData\" -e \"Data::ok\""; # Possibly a pointless test as this doesn't really verify that it's been # stubbed. -system "$runperl -w \"-I$lib\" -MEnd -e End::lime"; +system "$runperl -w \"-I$lib\" \"-MEnd\" -e \"End::lime\""; # But check that the documentation after the __END__ survived. open FH, "$lib/End.pm" or die $!; diff --git a/t/lib/switch.t b/t/lib/switch.t index 3fcd5cad4a..d1a8af191f 100644 --- a/t/lib/switch.t +++ b/t/lib/switch.t @@ -6,16 +6,8 @@ BEGIN { use Carp; use Switch qw(__ fallthrough); -print "1..293\n"; - -my $count = 0; -sub ok($) -{ - $count++; - print "line ", (caller)[2], "; " unless $_[0]; - print "not " unless $_[0]; - print "ok $count\n"; -} +my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"} +END{print"1..$C\n$M"} # NON-case THINGS; diff --git a/t/lib/syslfs.t b/t/lib/syslfs.t index 2bdb69d7e0..6a5d9b7874 100644 --- a/t/lib/syslfs.t +++ b/t/lib/syslfs.t @@ -16,6 +16,8 @@ BEGIN { use strict; +$| = 1; + our @s; our $fail; diff --git a/t/lib/tie-refhash.t b/t/lib/tie-refhash.t index a82c19c743..d80b2e10fc 100644 --- a/t/lib/tie-refhash.t +++ b/t/lib/tie-refhash.t @@ -1,19 +1,19 @@ #!/usr/bin/perl -w -# +# # Basic test suite for Tie::RefHash and Tie::RefHash::Nestable. -# +# # The testing is in two parts: first, run lots of tests on both a tied # hash and an ordinary un-tied hash, and check they give the same # answer. Then there are tests for those cases where the tied hashes # should behave differently to normal hashes, that is, when using # references as keys. -# +# BEGIN { chdir 't' if -d 't'; - @INC = '.'; + @INC = '.'; push @INC, '../lib'; -} +} use strict; use Tie::RefHash; @@ -28,7 +28,7 @@ my $ref = []; my $ref1 = []; # on a tied hash and on a normal hash, and checking that the results # are the same. This does of course assume that Perl hashes are not # buggy :-) -# +# my @tests = standard_hash_tests(); my @ordinary_results = runtests(\@tests, undef); @@ -40,13 +40,13 @@ foreach my $class ('Tie::RefHash', 'Tie::RefHash::Nestable') { foreach my $i (0 .. $#ordinary_results) { my ($or, $ow, $oe) = @{$ordinary_results[$i]}; my ($tr, $tw, $te) = @{$tied_results[$i]}; - + my $ok = 1; local $^W = 0; $ok = 0 if (defined($or) != defined($tr)) or ($or ne $tr); $ok = 0 if (defined($ow) != defined($tw)) or ($ow ne $tw); $ok = 0 if (defined($oe) != defined($te)) or ($oe ne $te); - + if (not $ok) { print STDERR "failed for $class: $tests[$i]\n", @@ -127,7 +127,7 @@ exit(); # Print 'ok X' if true, 'not ok X' if false # Uses global $currtest. -# +# sub test { my $t = shift; print 'not ' if not $t; @@ -135,7 +135,7 @@ sub test { } -# Wrapper for Data::Dumper to 'dump' a scalar as an EXPR string. +# Wrapper for Data::Dumper to 'dump' a scalar as an EXPR string. sub dumped { my $s = shift; my $d = Dumper($s); @@ -148,7 +148,7 @@ sub dumped { # Crudely dump a hash into a canonical string representation (because # hash keys can appear in any order, Data::Dumper may give different # strings for the same hash). -# +# sub dumph { my $h = shift; my $r = ''; @@ -159,17 +159,17 @@ sub dumph { } # Run the tests and give results. -# +# # Parameters: reference to list of tests to run # name of class to use for tied hash, or undef if not tied -# +# # Returns: list of [R, W, E] tuples, one for each test. # R is the return value from running the test, W any warnings it gave, # and E any exception raised with 'die'. E and W will be tidied up a # little to remove irrelevant details like line numbers :-) -# +# # Will also run a few of its own 'ok N' tests. -# +# sub runtests { my ($tests, $class) = @_; my @r; @@ -215,14 +215,14 @@ sub runtests { # Things that should work just the same for an ordinary hash and a # Tie::RefHash. -# +# # Each test is a code string to be eval'd, it should do something with # %h and give a scalar return value. The global $ref and $ref1 may # also be used. -# +# # One thing we don't test is that the ordering from 'keys', 'values' # and 'each' is the same. You can't reasonably expect that. -# +# sub standard_hash_tests { my @r; @@ -234,12 +234,12 @@ sub standard_hash_tests { { my ($k, $v, %tmp); $tmp{"$k$;$v"}++ while (($k, $v) = each %h); dumph(\%tmp) } END ; - + # Tests on the existence of the element 'foo' my $FOO_TESTS = <<'END' defined $h{foo}; exists $h{foo}; - $h{foo}; + $h{foo}; END ; @@ -278,7 +278,7 @@ END ; } } - + # Test hash slices my @slicetests; @slicetests = split /\n/, <<'END' diff --git a/t/op/die_exit.t b/t/op/die_exit.t index a389946fe3..f758f9c237 100755 --- a/t/op/die_exit.t +++ b/t/op/die_exit.t @@ -15,6 +15,8 @@ if ($^O eq 'mpeix') { exit 0; } +$| = 1; + my $perl = -e '../perl' ? '../perl' : -e './perl' ? './perl' : 'perl'; use strict; diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t index d761f73ce7..fb9fe4e95c 100755 --- a/t/op/lex_assign.t +++ b/t/op/lex_assign.t @@ -5,6 +5,7 @@ BEGIN { @INC = '../lib'; } +$| = 1; umask 0; $xref = \ ""; $runme = ($^O eq 'VMS' ? 'MCR ' : '') . $^X; diff --git a/t/op/lfs.t b/t/op/lfs.t index 0a1c399840..44a92c4855 100644 --- a/t/op/lfs.t +++ b/t/op/lfs.t @@ -54,6 +54,8 @@ EOM print "1..0 # Skip: @_\n" if @_; } +$| = 1; + print "# checking whether we have sparse files...\n"; # Known have-nots. diff --git a/t/op/re_tests b/t/op/re_tests index 6406fcdd5b..3989c06f14 100644 --- a/t/op/re_tests +++ b/t/op/re_tests @@ -787,3 +787,4 @@ tt+$ xxxtt y - - (a)?(a)+ a y $1:$2 :a - (ab)?(ab)+ ab y $1:$2 :ab - (abc)?(abc)+ abc y $1:$2 :abc - +'b\s^'m a\nb\n n - - diff --git a/t/op/subst.t b/t/op/subst.t index 7dd7a1c92c..907d0dadf6 100755 --- a/t/op/subst.t +++ b/t/op/subst.t @@ -6,7 +6,7 @@ BEGIN { require Config; import Config; } -print "1..84\n"; +print "1..85\n"; $x = 'foo'; $_ = "x"; @@ -379,3 +379,7 @@ $_ = "C:/"; s/^([a-z]:)/\u$1/ and print "not "; print "ok 84\n"; +$_ = "Charles Bronson"; +s/\B\w//g; +print $_ eq "C B" ? "ok 85\n" : "not ok 85\n# \$_ eq '$_'\n"; + diff --git a/t/op/taint.t b/t/op/taint.t index 2958a37b87..8ff566e7f6 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -15,6 +15,8 @@ BEGIN { use strict; use Config; +$| = 1; + # We do not want the whole taint.t to fail # just because Errno possibly failing. eval { require Errno; import Errno }; diff --git a/t/op/utf8decode.t b/t/op/utf8decode.t index cc2b26aaf3..cc2b26aaf3 100755..100644 --- a/t/op/utf8decode.t +++ b/t/op/utf8decode.t @@ -183,7 +183,7 @@ PERLVAR(Tregstartp, I32 *) /* Pointer to startp array. */ PERLVAR(Tregendp, I32 *) /* Ditto for endp. */ PERLVAR(Treglastparen, U32 *) /* Similarly for lastparen. */ PERLVAR(Tregtill, char *) /* How far we are required to go. */ -PERLVAR(Tregprev, char) /* char before regbol, \n if none */ +PERLVAR(Tregcompat1, char) /* used to be regprev1 */ PERLVAR(Treg_start_tmp, char **) /* from regexec.c */ PERLVAR(Treg_start_tmpl,U32) /* from regexec.c */ PERLVAR(Tregdata, struct reg_data *) @@ -6876,12 +6876,11 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) Read a number in any of the formats that Perl accepts: - 0(x[0-7A-F]+)|([0-7]+)|(b[01]) - \d([\d_]*\d)?(\.\d([\d_]*\d)?)?[Ee](\d+) - - Underbars (_) are allowed in decimal numbers. If -w is on, - underbars must not be consecutive, and they cannot start - or end integer or fractional parts. + \d(_?\d)*(\.(\d(_?\d)*)?)?[Ee](\d+) 12 12.34 12. + \.\d(_?\d)*[Ee](\d+) .34 + 0b[01](_?[01])* + 0[0-7](_?[0-7])* + 0x[0-9A-Fa-f](_?[0-9A-Fa-f])* Like most scan_ routines, it uses the PL_tokenbuf buffer to hold the thing it reads. @@ -577,18 +577,18 @@ Perl_set_numeric_radix(pTHX) lc = localeconv(); if (lc && lc->decimal_point) { if (lc->decimal_point[0] == '.' && lc->decimal_point[1] == 0) { - SvREFCNT_dec(PL_numeric_radix); - PL_numeric_radix = 0; + SvREFCNT_dec(PL_numeric_radix_sv); + PL_numeric_radix_sv = Nullsv; } else { - if (PL_numeric_radix) - sv_setpv(PL_numeric_radix, lc->decimal_point); + if (PL_numeric_radix_sv) + sv_setpv(PL_numeric_radix_sv, lc->decimal_point); else - PL_numeric_radix = newSVpv(lc->decimal_point, 0); + PL_numeric_radix_sv = newSVpv(lc->decimal_point, 0); } } else - PL_numeric_radix = 0; + PL_numeric_radix_sv = Nullsv; # endif /* HAS_LOCALECONV */ #endif /* USE_LOCALE_NUMERIC */ } |