From fc75d0664419eb8c8f264d8f298df2cd155c8966 Mon Sep 17 00:00:00 2001 From: Mark Murray Date: Sat, 16 Mar 2002 20:14:30 +0000 Subject: [PATCH] Vendor import Perl 5.6.1 --- contrib/perl5/AUTHORS | 677 +- contrib/perl5/Changes | 7397 ++++++++++++- contrib/perl5/Changes5.004 | 2 +- contrib/perl5/Configure | 3578 ++++--- contrib/perl5/EXTERN.h | 2 +- contrib/perl5/INSTALL | 344 +- contrib/perl5/INTERN.h | 2 +- contrib/perl5/MANIFEST | 167 +- contrib/perl5/Makefile.SH | 178 +- contrib/perl5/Policy_sh.SH | 52 +- contrib/perl5/Porting/Contract | 2 +- contrib/perl5/Porting/Glossary | 299 +- contrib/perl5/Porting/config.sh | 147 +- contrib/perl5/Porting/config_H | 299 +- contrib/perl5/Porting/genlog | 26 +- contrib/perl5/Porting/makerel | 43 +- contrib/perl5/Porting/p4desc | 43 +- contrib/perl5/Porting/patching.pod | 32 +- contrib/perl5/Porting/pumpkin.pod | 69 +- contrib/perl5/README | 10 +- contrib/perl5/README.Y2K | 2 +- contrib/perl5/Todo | 4 - contrib/perl5/Todo-5.6 | 72 +- contrib/perl5/av.c | 53 +- contrib/perl5/av.h | 6 +- contrib/perl5/bytecode.pl | 229 +- contrib/perl5/cflags.SH | 4 +- contrib/perl5/config_h.SH | 263 +- contrib/perl5/configpm | 98 +- contrib/perl5/configure.com | 4395 +++++++- contrib/perl5/configure.gnu | 4 +- contrib/perl5/cop.h | 47 +- contrib/perl5/cv.h | 2 +- contrib/perl5/deb.c | 5 +- contrib/perl5/doio.c | 240 +- contrib/perl5/doop.c | 915 +- contrib/perl5/dosish.h | 6 +- contrib/perl5/dump.c | 31 +- contrib/perl5/embed.h | 244 +- contrib/perl5/embed.pl | 214 +- contrib/perl5/embedvar.h | 77 +- contrib/perl5/ext/B/B.pm | 77 +- contrib/perl5/ext/B/B.xs | 51 +- contrib/perl5/ext/B/B/Asmdata.pm | 185 +- contrib/perl5/ext/B/B/Assembler.pm | 119 +- contrib/perl5/ext/B/B/Bytecode.pm | 415 +- contrib/perl5/ext/B/B/C.pm | 30 +- contrib/perl5/ext/B/B/CC.pm | 2 +- contrib/perl5/ext/B/B/Debug.pm | 17 +- contrib/perl5/ext/B/B/Deparse.pm | 456 +- contrib/perl5/ext/B/B/Disassembler.pm | 7 + contrib/perl5/ext/B/B/Lint.pm | 6 +- contrib/perl5/ext/B/B/Showlex.pm | 23 +- contrib/perl5/ext/B/B/Stash.pm | 10 +- contrib/perl5/ext/B/B/Terse.pm | 13 +- contrib/perl5/ext/B/Makefile.PL | 20 +- contrib/perl5/ext/B/O.pm | 3 +- contrib/perl5/ext/B/defsubs_h.PL | 13 +- contrib/perl5/ext/B/ramblings/flip-flop | 4 +- contrib/perl5/ext/ByteLoader/ByteLoader.pm | 6 +- contrib/perl5/ext/ByteLoader/ByteLoader.xs | 104 +- contrib/perl5/ext/ByteLoader/bytecode.h | 170 +- contrib/perl5/ext/ByteLoader/byterun.c | 411 +- contrib/perl5/ext/ByteLoader/byterun.h | 209 +- contrib/perl5/ext/DB_File/Changes | 43 + contrib/perl5/ext/DB_File/DB_File.pm | 26 +- contrib/perl5/ext/DB_File/DB_File.xs | 80 +- contrib/perl5/ext/DB_File/Makefile.PL | 1 + contrib/perl5/ext/DB_File/dbinfo | 18 +- contrib/perl5/ext/DB_File/typemap | 11 +- contrib/perl5/ext/DB_File/version.c | 12 +- contrib/perl5/ext/Data/Dumper/Dumper.pm | 11 +- contrib/perl5/ext/Data/Dumper/Dumper.xs | 8 +- contrib/perl5/ext/Devel/DProf/DProf.xs | 16 +- contrib/perl5/ext/Devel/Peek/Makefile.PL | 1 + contrib/perl5/ext/Devel/Peek/Peek.pm | 74 +- contrib/perl5/ext/Devel/Peek/Peek.xs | 194 +- contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL | 146 +- contrib/perl5/ext/DynaLoader/XSLoader_pm.PL | 6 +- contrib/perl5/ext/DynaLoader/dl_aix.xs | 110 +- contrib/perl5/ext/DynaLoader/dl_dlopen.xs | 4 +- contrib/perl5/ext/DynaLoader/hints/aix.pl | 6 +- contrib/perl5/ext/Errno/ChangeLog | 5 + contrib/perl5/ext/Errno/Errno_pm.PL | 82 +- contrib/perl5/ext/Fcntl/Fcntl.xs | 7 - contrib/perl5/ext/File/Glob/Changes | 2 + contrib/perl5/ext/File/Glob/Glob.pm | 112 +- contrib/perl5/ext/File/Glob/Glob.xs | 15 +- contrib/perl5/ext/File/Glob/bsd_glob.c | 44 +- contrib/perl5/ext/File/Glob/bsd_glob.h | 1 + contrib/perl5/ext/GDBM_File/GDBM_File.pm | 4 +- contrib/perl5/ext/GDBM_File/GDBM_File.xs | 12 +- contrib/perl5/ext/GDBM_File/typemap | 10 +- contrib/perl5/ext/IO/IO.xs | 15 +- contrib/perl5/ext/IO/lib/IO/Handle.pm | 62 +- contrib/perl5/ext/IO/lib/IO/Poll.pm | 73 +- contrib/perl5/ext/IO/lib/IO/Seekable.pm | 64 +- contrib/perl5/ext/IO/lib/IO/Select.pm | 7 +- contrib/perl5/ext/IO/lib/IO/Socket.pm | 2 +- contrib/perl5/ext/IO/lib/IO/Socket/INET.pm | 24 +- contrib/perl5/ext/IO/lib/IO/Socket/UNIX.pm | 2 +- contrib/perl5/ext/IPC/SysV/Makefile.PL | 2 +- contrib/perl5/ext/IPC/SysV/SysV.xs | 8 +- contrib/perl5/ext/NDBM_File/Makefile.PL | 1 + contrib/perl5/ext/NDBM_File/NDBM_File.pm | 101 +- contrib/perl5/ext/NDBM_File/NDBM_File.xs | 5 + contrib/perl5/ext/NDBM_File/typemap | 10 +- contrib/perl5/ext/ODBM_File/ODBM_File.pm | 92 +- contrib/perl5/ext/ODBM_File/ODBM_File.xs | 5 + contrib/perl5/ext/ODBM_File/typemap | 10 +- contrib/perl5/ext/Opcode/Opcode.pm | 4 +- contrib/perl5/ext/Opcode/Opcode.xs | 9 +- contrib/perl5/ext/POSIX/Makefile.PL | 7 +- contrib/perl5/ext/POSIX/POSIX.pm | 6 +- contrib/perl5/ext/POSIX/POSIX.pod | 639 +- contrib/perl5/ext/POSIX/POSIX.xs | 130 +- contrib/perl5/ext/POSIX/typemap | 1 + contrib/perl5/ext/SDBM_File/SDBM_File.pm | 89 +- contrib/perl5/ext/SDBM_File/SDBM_File.xs | 2 +- contrib/perl5/ext/SDBM_File/sdbm/dbm.c | 37 +- contrib/perl5/ext/SDBM_File/sdbm/dbm.h | 37 +- contrib/perl5/ext/SDBM_File/sdbm/sdbm.c | 21 + contrib/perl5/ext/SDBM_File/typemap | 10 +- contrib/perl5/ext/Socket/Socket.pm | 5 +- contrib/perl5/ext/Socket/Socket.xs | 5 +- contrib/perl5/ext/Sys/Syslog/Syslog.pm | 32 +- contrib/perl5/ext/Sys/Syslog/Syslog.xs | 3 +- contrib/perl5/ext/Thread/Thread.pm | 11 +- contrib/perl5/ext/Thread/Thread.xs | 14 +- contrib/perl5/ext/re/Makefile.PL | 39 +- contrib/perl5/ext/re/re.xs | 2 - contrib/perl5/form.h | 2 +- contrib/perl5/global.sym | 24 +- contrib/perl5/globals.c | 9 + contrib/perl5/gv.c | 283 +- contrib/perl5/gv.h | 2 +- contrib/perl5/handy.h | 103 +- contrib/perl5/hints/README.hints | 2 +- contrib/perl5/hints/aix.sh | 116 +- contrib/perl5/hints/bsdos.sh | 39 +- contrib/perl5/hints/cygwin.sh | 13 +- contrib/perl5/hints/darwin.sh | 2 +- contrib/perl5/hints/dec_osf.sh | 40 +- contrib/perl5/hints/dos_djgpp.sh | 5 +- contrib/perl5/hints/freebsd.sh | 7 +- contrib/perl5/hints/hpux.sh | 86 +- contrib/perl5/hints/irix_6.sh | 40 +- contrib/perl5/hints/linux.sh | 7 +- contrib/perl5/hints/machten.sh | 20 +- contrib/perl5/hints/mint.sh | 1 - contrib/perl5/hints/mpeix.sh | 38 +- contrib/perl5/hints/openbsd.sh | 27 +- contrib/perl5/hints/os2.sh | 18 +- contrib/perl5/hints/os390.sh | 152 +- contrib/perl5/hints/posix-bc.sh | 84 +- contrib/perl5/hints/powerux.sh | 2 +- contrib/perl5/hints/solaris_2.sh | 460 +- contrib/perl5/hints/svr4.sh | 16 + contrib/perl5/hints/titanos.sh | 1 - contrib/perl5/hints/unicos.sh | 19 +- contrib/perl5/hints/uts.sh | 20 +- contrib/perl5/hints/vmesa.sh | 3 +- contrib/perl5/hv.c | 28 +- contrib/perl5/hv.h | 20 +- contrib/perl5/installhtml | 3 +- contrib/perl5/installman | 176 +- contrib/perl5/installperl | 144 +- contrib/perl5/intrpvar.h | 68 +- contrib/perl5/iperlsys.h | 28 +- contrib/perl5/lib/AutoLoader.pm | 32 +- contrib/perl5/lib/AutoSplit.pm | 39 +- contrib/perl5/lib/Benchmark.pm | 5 +- contrib/perl5/lib/CPAN.pm | 3964 +++++-- contrib/perl5/lib/CPAN/FirstTime.pm | 188 +- contrib/perl5/lib/Carp/Heavy.pm | 14 +- contrib/perl5/lib/Class/Struct.pm | 44 +- contrib/perl5/lib/Cwd.pm | 122 +- contrib/perl5/lib/English.pm | 4 + contrib/perl5/lib/ExtUtils/Command.pm | 2 +- contrib/perl5/lib/ExtUtils/Embed.pm | 55 +- contrib/perl5/lib/ExtUtils/Install.pm | 132 +- contrib/perl5/lib/ExtUtils/Liblist.pm | 86 +- contrib/perl5/lib/ExtUtils/MM_Cygwin.pm | 2 + contrib/perl5/lib/ExtUtils/MM_OS2.pm | 16 + contrib/perl5/lib/ExtUtils/MM_Unix.pm | 136 +- contrib/perl5/lib/ExtUtils/MM_VMS.pm | 49 +- contrib/perl5/lib/ExtUtils/MM_Win32.pm | 4 +- contrib/perl5/lib/ExtUtils/MakeMaker.pm | 161 +- contrib/perl5/lib/ExtUtils/Manifest.pm | 91 +- contrib/perl5/lib/ExtUtils/Mksymlists.pm | 1 + contrib/perl5/lib/ExtUtils/typemap | 6 +- contrib/perl5/lib/ExtUtils/xsubpp | 96 +- contrib/perl5/lib/File/Basename.pm | 20 +- contrib/perl5/lib/File/Copy.pm | 33 +- contrib/perl5/lib/File/Find.pm | 98 +- contrib/perl5/lib/File/Path.pm | 39 +- contrib/perl5/lib/File/Spec.pm | 5 +- contrib/perl5/lib/File/Spec/Functions.pm | 4 +- contrib/perl5/lib/File/Spec/Mac.pm | 61 +- contrib/perl5/lib/File/Spec/OS2.pm | 5 +- contrib/perl5/lib/File/Spec/Unix.pm | 46 +- contrib/perl5/lib/File/Spec/VMS.pm | 69 +- contrib/perl5/lib/File/Spec/Win32.pm | 86 +- contrib/perl5/lib/FileHandle.pm | 6 +- contrib/perl5/lib/Getopt/Long.pm | 429 +- contrib/perl5/lib/IPC/Open3.pm | 31 +- contrib/perl5/lib/Math/BigFloat.pm | 84 +- contrib/perl5/lib/Math/BigInt.pm | 27 + contrib/perl5/lib/Math/Complex.pm | 427 +- contrib/perl5/lib/Math/Trig.pm | 43 +- contrib/perl5/lib/Net/Ping.pm | 36 +- contrib/perl5/lib/Net/protoent.pm | 3 +- contrib/perl5/lib/Pod/Checker.pm | 113 +- contrib/perl5/lib/Pod/Find.pm | 307 +- contrib/perl5/lib/Pod/Functions.pm | 2 +- contrib/perl5/lib/Pod/Html.pm | 12 +- contrib/perl5/lib/Pod/InputObjects.pm | 68 +- contrib/perl5/lib/Pod/Man.pm | 314 +- contrib/perl5/lib/Pod/ParseUtils.pm | 114 +- contrib/perl5/lib/Pod/Parser.pm | 11 +- contrib/perl5/lib/Pod/Select.pm | 24 +- contrib/perl5/lib/Pod/Text.pm | 188 +- contrib/perl5/lib/Pod/Text/Color.pm | 9 +- contrib/perl5/lib/Pod/Text/Termcap.pm | 9 +- contrib/perl5/lib/Pod/Usage.pm | 29 +- contrib/perl5/lib/SelfLoader.pm | 5 +- contrib/perl5/lib/Shell.pm | 73 +- contrib/perl5/lib/Symbol.pm | 11 +- contrib/perl5/lib/Term/ANSIColor.pm | 124 +- contrib/perl5/lib/Term/ReadLine.pm | 8 +- contrib/perl5/lib/Test.pm | 21 +- contrib/perl5/lib/Test/Harness.pm | 96 +- contrib/perl5/lib/Text/ParseWords.pm | 6 + contrib/perl5/lib/Text/Soundex.pm | 2 +- contrib/perl5/lib/Text/Tabs.pm | 8 +- contrib/perl5/lib/Text/Wrap.pm | 83 +- contrib/perl5/lib/Tie/Array.pm | 160 +- contrib/perl5/lib/Tie/Handle.pm | 26 +- contrib/perl5/lib/Tie/Hash.pm | 3 +- contrib/perl5/lib/Tie/RefHash.pm | 50 +- contrib/perl5/lib/Tie/Scalar.pm | 3 +- contrib/perl5/lib/Tie/SubstrHash.pm | 65 +- contrib/perl5/lib/base.pm | 2 +- contrib/perl5/lib/bigint.pl | 31 +- contrib/perl5/lib/bytes.pm | 25 +- contrib/perl5/lib/charnames.pm | 15 +- contrib/perl5/lib/diagnostics.pm | 100 +- contrib/perl5/lib/fields.pm | 3 +- contrib/perl5/lib/ftp.pl | 2 +- contrib/perl5/lib/getopts.pl | 65 +- contrib/perl5/lib/integer.pm | 79 +- contrib/perl5/lib/lib.pm | 3 + contrib/perl5/lib/overload.pm | 198 +- contrib/perl5/lib/perl5db.pl | 81 +- contrib/perl5/lib/strict.pm | 8 + contrib/perl5/lib/syslog.pl | 2 +- contrib/perl5/lib/termcap.pl | 2 +- contrib/perl5/lib/unicode/ArabLink.pl | 9 +- contrib/perl5/lib/unicode/ArabLnkGrp.pl | 5 +- contrib/perl5/lib/unicode/ArabShap.txt | 35 +- contrib/perl5/lib/unicode/Bidirectional.pl | 4 +- contrib/perl5/lib/unicode/Block.pl | 2 +- contrib/perl5/lib/unicode/Category.pl | 4 +- contrib/perl5/lib/unicode/CombiningClass.pl | 2 +- contrib/perl5/lib/unicode/CompExcl.txt | 6 +- contrib/perl5/lib/unicode/Decomposition.pl | 2 +- .../unicode/In/AlphabeticPresentationForms.pl | 2 +- contrib/perl5/lib/unicode/In/Arabic.pl | 2 +- .../unicode/In/ArabicPresentationForms-A.pl | 2 +- .../unicode/In/ArabicPresentationForms-B.pl | 2 +- contrib/perl5/lib/unicode/In/Armenian.pl | 2 +- contrib/perl5/lib/unicode/In/Arrows.pl | 2 +- contrib/perl5/lib/unicode/In/BasicLatin.pl | 2 +- contrib/perl5/lib/unicode/In/Bengali.pl | 2 +- contrib/perl5/lib/unicode/In/BlockElements.pl | 2 +- contrib/perl5/lib/unicode/In/Bopomofo.pl | 2 +- .../perl5/lib/unicode/In/BopomofoExtended.pl | 2 +- contrib/perl5/lib/unicode/In/BoxDrawing.pl | 2 +- .../perl5/lib/unicode/In/BraillePatterns.pl | 2 +- .../perl5/lib/unicode/In/CJKCompatibility.pl | 2 +- .../lib/unicode/In/CJKCompatibilityForms.pl | 2 +- .../unicode/In/CJKCompatibilityIdeographs.pl | 2 +- .../lib/unicode/In/CJKRadicalsSupplement.pl | 2 +- .../unicode/In/CJKSymbolsandPunctuation.pl | 2 +- .../lib/unicode/In/CJKUnifiedIdeographs.pl | 2 +- .../In/CJKUnifiedIdeographsExtensionA.pl | 2 +- contrib/perl5/lib/unicode/In/Cherokee.pl | 2 +- .../unicode/In/CombiningDiacriticalMarks.pl | 2 +- .../lib/unicode/In/CombiningHalfMarks.pl | 2 +- .../unicode/In/CombiningMarksforSymbols.pl | 2 +- .../perl5/lib/unicode/In/ControlPictures.pl | 2 +- .../perl5/lib/unicode/In/CurrencySymbols.pl | 2 +- contrib/perl5/lib/unicode/In/Cyrillic.pl | 2 +- contrib/perl5/lib/unicode/In/Devanagari.pl | 2 +- contrib/perl5/lib/unicode/In/Dingbats.pl | 2 +- .../lib/unicode/In/EnclosedAlphanumerics.pl | 2 +- .../unicode/In/EnclosedCJKLettersandMonths.pl | 2 +- contrib/perl5/lib/unicode/In/Ethiopic.pl | 2 +- .../lib/unicode/In/GeneralPunctuation.pl | 2 +- .../perl5/lib/unicode/In/GeometricShapes.pl | 2 +- contrib/perl5/lib/unicode/In/Georgian.pl | 2 +- contrib/perl5/lib/unicode/In/Greek.pl | 2 +- contrib/perl5/lib/unicode/In/GreekExtended.pl | 2 +- contrib/perl5/lib/unicode/In/Gujarati.pl | 2 +- contrib/perl5/lib/unicode/In/Gurmukhi.pl | 2 +- .../unicode/In/HalfwidthandFullwidthForms.pl | 2 +- .../lib/unicode/In/HangulCompatibilityJamo.pl | 2 +- contrib/perl5/lib/unicode/In/HangulJamo.pl | 2 +- .../perl5/lib/unicode/In/HangulSyllables.pl | 2 +- contrib/perl5/lib/unicode/In/Hebrew.pl | 2 +- .../unicode/In/HighPrivateUseSurrogates.pl | 2 +- .../perl5/lib/unicode/In/HighSurrogates.pl | 2 +- contrib/perl5/lib/unicode/In/Hiragana.pl | 2 +- contrib/perl5/lib/unicode/In/IPAExtensions.pl | 2 +- .../In/IdeographicDescriptionCharacters.pl | 2 +- contrib/perl5/lib/unicode/In/Kanbun.pl | 2 +- .../perl5/lib/unicode/In/KangxiRadicals.pl | 2 +- contrib/perl5/lib/unicode/In/Kannada.pl | 2 +- contrib/perl5/lib/unicode/In/Katakana.pl | 2 +- contrib/perl5/lib/unicode/In/Khmer.pl | 2 +- contrib/perl5/lib/unicode/In/Lao.pl | 2 +- .../perl5/lib/unicode/In/Latin-1Supplement.pl | 2 +- .../perl5/lib/unicode/In/LatinExtended-A.pl | 2 +- .../perl5/lib/unicode/In/LatinExtended-B.pl | 2 +- .../lib/unicode/In/LatinExtendedAdditional.pl | 2 +- .../perl5/lib/unicode/In/LetterlikeSymbols.pl | 2 +- contrib/perl5/lib/unicode/In/LowSurrogates.pl | 2 +- contrib/perl5/lib/unicode/In/Malayalam.pl | 2 +- .../lib/unicode/In/MathematicalOperators.pl | 2 +- .../lib/unicode/In/MiscellaneousSymbols.pl | 2 +- .../lib/unicode/In/MiscellaneousTechnical.pl | 2 +- contrib/perl5/lib/unicode/In/Mongolian.pl | 2 +- contrib/perl5/lib/unicode/In/Myanmar.pl | 2 +- contrib/perl5/lib/unicode/In/NumberForms.pl | 2 +- contrib/perl5/lib/unicode/In/Ogham.pl | 2 +- .../unicode/In/OpticalCharacterRecognition.pl | 2 +- contrib/perl5/lib/unicode/In/Oriya.pl | 2 +- contrib/perl5/lib/unicode/In/PrivateUse.pl | 2 +- contrib/perl5/lib/unicode/In/Runic.pl | 2 +- contrib/perl5/lib/unicode/In/Sinhala.pl | 2 +- .../perl5/lib/unicode/In/SmallFormVariants.pl | 2 +- .../lib/unicode/In/SpacingModifierLetters.pl | 2 +- contrib/perl5/lib/unicode/In/Specials.pl | 2 +- .../unicode/In/SuperscriptsandSubscripts.pl | 2 +- contrib/perl5/lib/unicode/In/Syriac.pl | 2 +- contrib/perl5/lib/unicode/In/Tamil.pl | 2 +- contrib/perl5/lib/unicode/In/Telugu.pl | 2 +- contrib/perl5/lib/unicode/In/Thaana.pl | 2 +- contrib/perl5/lib/unicode/In/Thai.pl | 2 +- contrib/perl5/lib/unicode/In/Tibetan.pl | 2 +- .../In/UnifiedCanadianAboriginalSyllabics.pl | 2 +- contrib/perl5/lib/unicode/In/YiRadicals.pl | 2 +- contrib/perl5/lib/unicode/In/YiSyllables.pl | 2 +- contrib/perl5/lib/unicode/Is/ASCII.pl | 2 +- contrib/perl5/lib/unicode/Is/Alnum.pl | 184 +- contrib/perl5/lib/unicode/Is/Alpha.pl | 159 +- contrib/perl5/lib/unicode/Is/BidiAN.pl | 2 +- contrib/perl5/lib/unicode/Is/BidiB.pl | 2 +- contrib/perl5/lib/unicode/Is/BidiCS.pl | 2 +- contrib/perl5/lib/unicode/Is/BidiEN.pl | 2 +- contrib/perl5/lib/unicode/Is/BidiES.pl | 2 +- contrib/perl5/lib/unicode/Is/BidiET.pl | 2 +- contrib/perl5/lib/unicode/Is/BidiL.pl | 4 +- contrib/perl5/lib/unicode/Is/BidiON.pl | 2 +- contrib/perl5/lib/unicode/Is/BidiR.pl | 2 +- contrib/perl5/lib/unicode/Is/BidiS.pl | 2 +- contrib/perl5/lib/unicode/Is/BidiWS.pl | 2 +- contrib/perl5/lib/unicode/Is/C.pl | 4 +- contrib/perl5/lib/unicode/Is/Cc.pl | 2 +- contrib/perl5/lib/unicode/Is/Cn.pl | 370 +- contrib/perl5/lib/unicode/Is/Cntrl.pl | 4 +- contrib/perl5/lib/unicode/Is/Co.pl | 4 +- contrib/perl5/lib/unicode/Is/DCcircle.pl | 2 +- contrib/perl5/lib/unicode/Is/DCcompat.pl | 2 +- contrib/perl5/lib/unicode/Is/DCfinal.pl | 2 +- contrib/perl5/lib/unicode/Is/DCfont.pl | 2 +- contrib/perl5/lib/unicode/Is/DCinitial.pl | 2 +- contrib/perl5/lib/unicode/Is/DCisolated.pl | 2 +- contrib/perl5/lib/unicode/Is/DCnarrow.pl | 2 +- contrib/perl5/lib/unicode/Is/DCnoBreak.pl | 2 +- contrib/perl5/lib/unicode/Is/DCsmall.pl | 2 +- contrib/perl5/lib/unicode/Is/DCsquare.pl | 2 +- contrib/perl5/lib/unicode/Is/DCsub.pl | 2 +- contrib/perl5/lib/unicode/Is/DCsuper.pl | 2 +- contrib/perl5/lib/unicode/Is/DCvertical.pl | 2 +- contrib/perl5/lib/unicode/Is/DCwide.pl | 2 +- contrib/perl5/lib/unicode/Is/DecoCanon.pl | 2 +- contrib/perl5/lib/unicode/Is/DecoCompat.pl | 2 +- contrib/perl5/lib/unicode/Is/Digit.pl | 2 +- contrib/perl5/lib/unicode/Is/Graph.pl | 16 +- contrib/perl5/lib/unicode/Is/L.pl | 2 +- contrib/perl5/lib/unicode/Is/Ll.pl | 2 +- contrib/perl5/lib/unicode/Is/Lm.pl | 2 +- contrib/perl5/lib/unicode/Is/Lo.pl | 2 +- contrib/perl5/lib/unicode/Is/Lower.pl | 2 +- contrib/perl5/lib/unicode/Is/Lt.pl | 2 +- contrib/perl5/lib/unicode/Is/Lu.pl | 2 +- contrib/perl5/lib/unicode/Is/M.pl | 2 +- contrib/perl5/lib/unicode/Is/Mc.pl | 2 +- contrib/perl5/lib/unicode/Is/Mirrored.pl | 2 +- contrib/perl5/lib/unicode/Is/Mn.pl | 2 +- contrib/perl5/lib/unicode/Is/N.pl | 2 +- contrib/perl5/lib/unicode/Is/Nd.pl | 2 +- contrib/perl5/lib/unicode/Is/No.pl | 2 +- contrib/perl5/lib/unicode/Is/P.pl | 2 +- contrib/perl5/lib/unicode/Is/Pd.pl | 2 +- contrib/perl5/lib/unicode/Is/Pe.pl | 2 +- contrib/perl5/lib/unicode/Is/Po.pl | 2 +- contrib/perl5/lib/unicode/Is/Print.pl | 7 +- contrib/perl5/lib/unicode/Is/Ps.pl | 2 +- contrib/perl5/lib/unicode/Is/Punct.pl | 2 +- contrib/perl5/lib/unicode/Is/S.pl | 2 +- contrib/perl5/lib/unicode/Is/Sc.pl | 2 +- contrib/perl5/lib/unicode/Is/Sm.pl | 2 +- contrib/perl5/lib/unicode/Is/So.pl | 2 +- contrib/perl5/lib/unicode/Is/Space.pl | 5 +- contrib/perl5/lib/unicode/Is/SylA.pl | 155 +- contrib/perl5/lib/unicode/Is/SylC.pl | 67 +- contrib/perl5/lib/unicode/Is/SylE.pl | 144 +- contrib/perl5/lib/unicode/Is/SylI.pl | 151 +- contrib/perl5/lib/unicode/Is/SylO.pl | 154 +- contrib/perl5/lib/unicode/Is/SylU.pl | 119 +- contrib/perl5/lib/unicode/Is/SylV.pl | 51 +- contrib/perl5/lib/unicode/Is/SylWA.pl | 46 +- contrib/perl5/lib/unicode/Is/SylWC.pl | 10 +- contrib/perl5/lib/unicode/Is/SylWE.pl | 20 +- contrib/perl5/lib/unicode/Is/SylWI.pl | 19 +- contrib/perl5/lib/unicode/Is/SylWV.pl | 8 +- contrib/perl5/lib/unicode/Is/Upper.pl | 19 +- contrib/perl5/lib/unicode/Is/Word.pl | 184 +- contrib/perl5/lib/unicode/Is/XDigit.pl | 2 +- contrib/perl5/lib/unicode/Is/Z.pl | 2 +- contrib/perl5/lib/unicode/Is/Zl.pl | 2 +- contrib/perl5/lib/unicode/Is/Zp.pl | 2 +- contrib/perl5/lib/unicode/Is/Zs.pl | 2 +- contrib/perl5/lib/unicode/Jamo.txt | 158 +- contrib/perl5/lib/unicode/JamoShort.pl | 136 +- contrib/perl5/lib/unicode/Makefile | 3 +- contrib/perl5/lib/unicode/Name.pl | 4 +- contrib/perl5/lib/unicode/Number.pl | 48 +- contrib/perl5/lib/unicode/ReadMe.txt | 40 +- contrib/perl5/lib/unicode/SpecCase.txt | 37 +- contrib/perl5/lib/unicode/To/Digit.pl | 2 +- contrib/perl5/lib/unicode/To/Lower.pl | 2 +- contrib/perl5/lib/unicode/To/Title.pl | 2 +- contrib/perl5/lib/unicode/To/Upper.pl | 2 +- contrib/perl5/lib/unicode/mktables.PL | 174 +- contrib/perl5/lib/unicode/syllables.txt | 2658 ++--- contrib/perl5/lib/utf8.pm | 11 +- contrib/perl5/lib/vars.pm | 6 +- contrib/perl5/lib/warnings.pm | 211 +- contrib/perl5/lib/warnings/register.pm | 8 + contrib/perl5/makedef.pl | 113 +- contrib/perl5/makedepend.SH | 51 +- contrib/perl5/malloc.c | 205 +- contrib/perl5/mg.c | 118 +- contrib/perl5/mg.h | 2 +- contrib/perl5/minimod.pl | 2 +- contrib/perl5/myconfig.SH | 13 +- contrib/perl5/objXSUB.h | 103 +- contrib/perl5/op.c | 579 +- contrib/perl5/op.h | 31 +- contrib/perl5/opcode.h | 10 +- contrib/perl5/opcode.pl | 115 +- contrib/perl5/opnames.h | 46 + contrib/perl5/patchlevel.h | 2 +- contrib/perl5/perl.c | 550 +- contrib/perl5/perl.h | 305 +- contrib/perl5/perlapi.c | 219 +- contrib/perl5/perlapi.h | 38 +- contrib/perl5/perlio.c | 22 +- contrib/perl5/perlsdio.h | 20 +- contrib/perl5/perlsfio.h | 24 +- contrib/perl5/perly.c | 8 +- contrib/perl5/perly.y | 5 +- contrib/perl5/perly_c.diff | 16 +- contrib/perl5/pod/perl.pod | 162 +- contrib/perl5/pod/perl5004delta.pod | 39 +- contrib/perl5/pod/perl5005delta.pod | 28 +- contrib/perl5/pod/perlapi.pod | 1440 ++- contrib/perl5/pod/perlbook.pod | 13 +- contrib/perl5/pod/perlboot.pod | 10 +- contrib/perl5/pod/perlcall.pod | 24 +- contrib/perl5/pod/perlcompile.pod | 11 +- contrib/perl5/pod/perldata.pod | 67 +- contrib/perl5/pod/perldbmfilter.pod | 2 +- contrib/perl5/pod/perldebguts.pod | 48 +- contrib/perl5/pod/perldebug.pod | 23 +- contrib/perl5/pod/perldelta.pod | 797 +- contrib/perl5/pod/perldiag.pod | 3474 ++++--- contrib/perl5/pod/perlembed.pod | 118 +- contrib/perl5/pod/perlfaq.pod | 1233 ++- contrib/perl5/pod/perlfaq1.pod | 86 +- contrib/perl5/pod/perlfaq2.pod | 317 +- contrib/perl5/pod/perlfaq3.pod | 310 +- contrib/perl5/pod/perlfaq4.pod | 107 +- contrib/perl5/pod/perlfaq5.pod | 143 +- contrib/perl5/pod/perlfaq6.pod | 61 +- contrib/perl5/pod/perlfaq7.pod | 97 +- contrib/perl5/pod/perlfaq8.pod | 115 +- contrib/perl5/pod/perlfaq9.pod | 121 +- contrib/perl5/pod/perlfilter.pod | 1 - contrib/perl5/pod/perlfork.pod | 22 +- contrib/perl5/pod/perlfunc.pod | 340 +- contrib/perl5/pod/perlguts.pod | 665 +- contrib/perl5/pod/perlhack.pod | 1500 ++- contrib/perl5/pod/perlhist.pod | 12 +- contrib/perl5/pod/perlintern.pod | 98 +- contrib/perl5/pod/perlipc.pod | 58 +- contrib/perl5/pod/perllexwarn.pod | 145 +- contrib/perl5/pod/perllocale.pod | 134 +- contrib/perl5/pod/perllol.pod | 8 +- contrib/perl5/pod/perlmod.pod | 60 +- contrib/perl5/pod/perlmodinstall.pod | 169 +- contrib/perl5/pod/perlmodlib.pod | 1195 ++- contrib/perl5/pod/perlnumber.pod | 8 +- contrib/perl5/pod/perlobj.pod | 16 +- contrib/perl5/pod/perlop.pod | 154 +- contrib/perl5/pod/perlopentut.pod | 26 +- contrib/perl5/pod/perlpod.pod | 20 +- contrib/perl5/pod/perlport.pod | 249 +- contrib/perl5/pod/perlre.pod | 99 +- contrib/perl5/pod/perlreftut.pod | 2 +- contrib/perl5/pod/perlrun.pod | 50 +- contrib/perl5/pod/perlsec.pod | 74 +- contrib/perl5/pod/perlsub.pod | 30 +- contrib/perl5/pod/perlsyn.pod | 30 +- contrib/perl5/pod/perlthrtut.pod | 6 +- contrib/perl5/pod/perltie.pod | 341 +- contrib/perl5/pod/perltoc.pod | 9159 +++++++++++------ contrib/perl5/pod/perltodo.pod | 18 +- contrib/perl5/pod/perltoot.pod | 18 +- contrib/perl5/pod/perltootc.pod | 18 +- contrib/perl5/pod/perltrap.pod | 115 +- contrib/perl5/pod/perlunicode.pod | 48 +- contrib/perl5/pod/perlvar.pod | 37 +- contrib/perl5/pod/perlxs.pod | 223 +- contrib/perl5/pod/perlxstut.pod | 152 +- contrib/perl5/pod/pod2latex.PL | 908 +- contrib/perl5/pod/pod2man.PL | 38 +- contrib/perl5/pod/pod2text.PL | 30 +- contrib/perl5/pod/pod2usage.PL | 2 +- contrib/perl5/pod/podchecker.PL | 32 +- contrib/perl5/pod/podselect.PL | 2 +- contrib/perl5/pod/roffitall | 136 +- contrib/perl5/pp.c | 684 +- contrib/perl5/pp.h | 29 +- contrib/perl5/pp.sym | 2 + contrib/perl5/pp_ctl.c | 361 +- contrib/perl5/pp_hot.c | 374 +- contrib/perl5/pp_proto.h | 2 + contrib/perl5/pp_sys.c | 807 +- contrib/perl5/proto.h | 109 +- contrib/perl5/regcomp.c | 817 +- contrib/perl5/regcomp.h | 26 +- contrib/perl5/regcomp.pl | 8 +- contrib/perl5/regexec.c | 505 +- contrib/perl5/regexp.h | 2 + contrib/perl5/regnodes.h | 8 +- contrib/perl5/run.c | 17 +- contrib/perl5/scope.c | 126 +- contrib/perl5/scope.h | 35 +- contrib/perl5/sv.c | 1140 +- contrib/perl5/sv.h | 109 +- contrib/perl5/t/README | 2 +- contrib/perl5/t/TEST | 9 +- contrib/perl5/t/UTEST | 5 +- contrib/perl5/t/base/lex.t | 41 +- contrib/perl5/t/base/rs.t | 2 + contrib/perl5/t/base/term.t | 4 +- contrib/perl5/t/comp/bproto.t | 2 +- contrib/perl5/t/comp/colon.t | 2 +- contrib/perl5/t/comp/cpp.t | 2 +- contrib/perl5/t/comp/proto.t | 34 +- contrib/perl5/t/comp/require.t | 31 +- contrib/perl5/t/comp/use.t | 2 +- contrib/perl5/t/harness | 12 +- contrib/perl5/t/io/argv.t | 14 +- contrib/perl5/t/io/fs.t | 21 +- contrib/perl5/t/io/open.t | 15 +- contrib/perl5/t/io/openpid.t | 16 +- contrib/perl5/t/io/pipe.t | 2 +- contrib/perl5/t/io/tell.t | 16 +- contrib/perl5/t/lib/abbrev.t | 2 +- contrib/perl5/t/lib/ansicolor.t | 16 +- contrib/perl5/t/lib/anydbm.t | 8 +- contrib/perl5/t/lib/attrs.t | 2 +- contrib/perl5/t/lib/autoloader.t | 3 +- contrib/perl5/t/lib/basename.t | 29 +- contrib/perl5/t/lib/bigfltpm.t | 89 +- contrib/perl5/t/lib/bigint.t | 2 +- contrib/perl5/t/lib/bigintpm.t | 2 +- contrib/perl5/t/lib/cgi-form.t | 69 +- contrib/perl5/t/lib/cgi-function.t | 77 +- contrib/perl5/t/lib/cgi-html.t | 102 +- contrib/perl5/t/lib/cgi-request.t | 69 +- contrib/perl5/t/lib/charnames.t | 44 +- contrib/perl5/t/lib/checktree.t | 2 +- contrib/perl5/t/lib/complex.t | 45 +- contrib/perl5/t/lib/db-btree.t | 138 +- contrib/perl5/t/lib/db-hash.t | 92 +- contrib/perl5/t/lib/db-recno.t | 54 +- contrib/perl5/t/lib/dirhand.t | 2 +- contrib/perl5/t/lib/dosglob.t | 4 +- contrib/perl5/t/lib/dprof.t | 24 +- contrib/perl5/t/lib/dprof/V.pm | 8 +- contrib/perl5/t/lib/dumper-ovl.t | 7 +- contrib/perl5/t/lib/dumper.t | 31 +- contrib/perl5/t/lib/english.t | 4 +- contrib/perl5/t/lib/env-array.t | 2 +- contrib/perl5/t/lib/env.t | 2 +- contrib/perl5/t/lib/errno.t | 6 +- contrib/perl5/t/lib/fatal.t | 2 +- contrib/perl5/t/lib/fields.t | 2 +- contrib/perl5/t/lib/filecache.t | 2 +- contrib/perl5/t/lib/filecopy.t | 2 +- contrib/perl5/t/lib/filefind.t | 33 +- contrib/perl5/t/lib/filefunc.t | 2 +- contrib/perl5/t/lib/filehand.t | 4 +- contrib/perl5/t/lib/filepath.t | 2 +- contrib/perl5/t/lib/filespec.t | 2 +- contrib/perl5/t/lib/findbin.t | 2 +- contrib/perl5/t/lib/gdbm.t | 60 +- contrib/perl5/t/lib/getopt.t | 2 +- contrib/perl5/t/lib/glob-basic.t | 36 +- contrib/perl5/t/lib/glob-case.t | 17 +- contrib/perl5/t/lib/glob-global.t | 88 +- contrib/perl5/t/lib/glob-taint.t | 9 +- contrib/perl5/t/lib/gol-basic.t | 10 +- contrib/perl5/t/lib/gol-compat.t | 4 +- contrib/perl5/t/lib/gol-linkage.t | 4 +- contrib/perl5/t/lib/h2ph.t | 2 +- contrib/perl5/t/lib/hostname.t | 7 +- contrib/perl5/t/lib/io_const.t | 2 +- contrib/perl5/t/lib/io_dir.t | 2 +- contrib/perl5/t/lib/io_dup.t | 2 +- contrib/perl5/t/lib/io_linenum.t | 2 +- contrib/perl5/t/lib/io_multihomed.t | 2 +- contrib/perl5/t/lib/io_pipe.t | 2 +- contrib/perl5/t/lib/io_poll.t | 9 +- contrib/perl5/t/lib/io_sel.t | 2 +- contrib/perl5/t/lib/io_sock.t | 30 +- contrib/perl5/t/lib/io_taint.t | 2 +- contrib/perl5/t/lib/io_tell.t | 2 +- contrib/perl5/t/lib/io_udp.t | 14 +- contrib/perl5/t/lib/io_unix.t | 2 +- contrib/perl5/t/lib/io_xs.t | 3 +- contrib/perl5/t/lib/ipc_sysv.t | 6 +- contrib/perl5/t/lib/ndbm.t | 73 +- contrib/perl5/t/lib/odbm.t | 77 +- contrib/perl5/t/lib/opcode.t | 2 +- contrib/perl5/t/lib/open2.t | 2 +- contrib/perl5/t/lib/open3.t | 4 +- contrib/perl5/t/lib/ops.t | 2 +- contrib/perl5/t/lib/parsewords.t | 2 +- contrib/perl5/t/lib/ph.t | 2 +- contrib/perl5/t/lib/posix.t | 13 +- contrib/perl5/t/lib/safe1.t | 2 +- contrib/perl5/t/lib/safe2.t | 2 +- contrib/perl5/t/lib/sdbm.t | 79 +- contrib/perl5/t/lib/searchdict.t | 2 +- contrib/perl5/t/lib/selectsaver.t | 2 +- contrib/perl5/t/lib/socket.t | 10 +- contrib/perl5/t/lib/soundex.t | 2 +- contrib/perl5/t/lib/symbol.t | 2 +- contrib/perl5/t/lib/syslfs.t | 112 +- contrib/perl5/t/lib/textfill.t | 2 +- contrib/perl5/t/lib/texttabs.t | 141 +- contrib/perl5/t/lib/textwrap.t | 92 +- contrib/perl5/t/lib/thr5005.t | 19 +- contrib/perl5/t/lib/tie-push.t | 3 +- contrib/perl5/t/lib/tie-stdarray.t | 3 +- contrib/perl5/t/lib/tie-stdhandle.t | 12 +- contrib/perl5/t/lib/tie-stdpush.t | 3 +- contrib/perl5/t/lib/timelocal.t | 2 +- contrib/perl5/t/lib/trig.t | 51 +- contrib/perl5/t/op/64bitint.t | 201 +- contrib/perl5/t/op/append.t | 40 +- contrib/perl5/t/op/args.t | 23 +- contrib/perl5/t/op/arith.t | 9 +- contrib/perl5/t/op/array.t | 19 +- contrib/perl5/t/op/assignwarn.t | 18 +- contrib/perl5/t/op/attrs.t | 2 +- contrib/perl5/t/op/avhv.t | 2 +- contrib/perl5/t/op/bop.t | 94 +- contrib/perl5/t/op/chop.t | 29 +- contrib/perl5/t/op/closure.t | 2 +- contrib/perl5/t/op/defins.t | 2 +- contrib/perl5/t/op/die_exit.t | 2 +- contrib/perl5/t/op/exists_sub.t | 2 +- contrib/perl5/t/op/filetest.t | 2 +- contrib/perl5/t/op/flip.t | 11 +- contrib/perl5/t/op/fork.t | 49 +- contrib/perl5/t/op/glob.t | 2 +- contrib/perl5/t/op/goto_xs.t | 2 +- contrib/perl5/t/op/grent.t | 37 +- contrib/perl5/t/op/groups.t | 3 +- contrib/perl5/t/op/gv.t | 42 +- contrib/perl5/t/op/hashwarn.t | 2 +- contrib/perl5/t/op/int.t | 10 +- contrib/perl5/t/op/join.t | 47 +- contrib/perl5/t/op/lex_assign.t | 17 +- contrib/perl5/t/op/lfs.t | 102 +- contrib/perl5/t/op/local.t | 3 - contrib/perl5/t/op/lop.t | 2 +- contrib/perl5/t/op/magic.t | 10 +- contrib/perl5/t/op/method.t | 20 +- contrib/perl5/t/op/misc.t | 72 +- contrib/perl5/t/op/mkdir.t | 2 +- contrib/perl5/t/op/my.t | 9 +- contrib/perl5/t/op/nothr5005.t | 2 +- contrib/perl5/t/op/numconvert.t | 8 +- contrib/perl5/t/op/oct.t | 107 +- contrib/perl5/t/op/pack.t | 19 +- contrib/perl5/t/op/pat.t | 157 +- contrib/perl5/t/op/pos.t | 9 +- contrib/perl5/t/op/pwent.t | 45 +- contrib/perl5/t/op/quotemeta.t | 11 +- contrib/perl5/t/op/rand.t | 2 +- contrib/perl5/t/op/re_tests | 106 +- contrib/perl5/t/op/readdir.t | 8 +- contrib/perl5/t/op/regexp.t | 16 +- contrib/perl5/t/op/runlevel.t | 17 +- contrib/perl5/t/op/sort.t | 61 +- contrib/perl5/t/op/split.t | 24 +- contrib/perl5/t/op/sprintf.t | 310 +- contrib/perl5/t/op/stat.t | 25 +- contrib/perl5/t/op/subst.t | 2 +- contrib/perl5/t/op/subst_amp.t | 2 +- contrib/perl5/t/op/substr.t | 321 +- contrib/perl5/t/op/taint.t | 75 +- contrib/perl5/t/op/tie.t | 17 +- contrib/perl5/t/op/tiearray.t | 2 +- contrib/perl5/t/op/tiehandle.t | 20 +- contrib/perl5/t/op/tr.t | 276 +- contrib/perl5/t/op/undef.t | 2 +- contrib/perl5/t/op/universal.t | 42 +- contrib/perl5/t/op/vec.t | 59 +- contrib/perl5/t/op/ver.t | 119 +- contrib/perl5/t/op/wantarray.t | 6 +- contrib/perl5/t/op/write.t | 19 +- contrib/perl5/t/pod/emptycmd.t | 4 +- contrib/perl5/t/pod/for.t | 4 +- contrib/perl5/t/pod/headings.t | 4 +- contrib/perl5/t/pod/include.t | 4 +- contrib/perl5/t/pod/included.t | 4 +- contrib/perl5/t/pod/lref.t | 4 +- contrib/perl5/t/pod/multiline_items.t | 4 +- contrib/perl5/t/pod/nested_items.t | 4 +- contrib/perl5/t/pod/nested_seqs.t | 4 +- contrib/perl5/t/pod/oneline_cmds.t | 4 +- contrib/perl5/t/pod/pod2usage.t | 4 +- contrib/perl5/t/pod/poderrs.t | 83 +- contrib/perl5/t/pod/poderrs.xr | 79 +- contrib/perl5/t/pod/podselect.t | 4 +- contrib/perl5/t/pod/special_seqs.t | 7 +- contrib/perl5/t/pod/special_seqs.xr | 3 + contrib/perl5/t/pod/testp2pt.pl | 10 +- contrib/perl5/t/pragma/constant.t | 2 +- contrib/perl5/t/pragma/diagnostics.t | 4 +- contrib/perl5/t/pragma/locale.t | 181 +- contrib/perl5/t/pragma/overload.t | 65 +- contrib/perl5/t/pragma/strict-vars | 25 +- contrib/perl5/t/pragma/strict.t | 4 +- contrib/perl5/t/pragma/sub_lval.t | 159 +- contrib/perl5/t/pragma/subs.t | 26 +- contrib/perl5/t/pragma/utf8.t | 353 +- contrib/perl5/t/pragma/warn/2use | 256 +- contrib/perl5/t/pragma/warn/3both | 69 + contrib/perl5/t/pragma/warn/4lint | 116 +- contrib/perl5/t/pragma/warn/5nolint | 108 + contrib/perl5/t/pragma/warn/6default | 68 + contrib/perl5/t/pragma/warn/7fatal | 70 + contrib/perl5/t/pragma/warn/9enabled | 347 +- contrib/perl5/t/pragma/warn/doio | 40 +- contrib/perl5/t/pragma/warn/op | 17 +- contrib/perl5/t/pragma/warn/perl | 15 + contrib/perl5/t/pragma/warn/pp_ctl | 15 +- contrib/perl5/t/pragma/warn/pp_hot | 34 +- contrib/perl5/t/pragma/warn/pp_sys | 137 +- contrib/perl5/t/pragma/warn/regcomp | 92 +- contrib/perl5/t/pragma/warn/sv | 2 +- contrib/perl5/t/pragma/warn/toke | 58 +- contrib/perl5/t/pragma/warn/utf8 | 10 +- contrib/perl5/t/pragma/warnings.t | 6 +- contrib/perl5/taint.c | 7 - contrib/perl5/thrdvar.h | 17 + contrib/perl5/thread.h | 42 +- contrib/perl5/toke.c | 1115 +- contrib/perl5/universal.c | 65 +- contrib/perl5/unixish.h | 9 +- contrib/perl5/utf8.c | 691 +- contrib/perl5/utf8.h | 90 +- contrib/perl5/util.c | 543 +- contrib/perl5/util.h | 12 +- contrib/perl5/utils/Makefile | 17 +- contrib/perl5/utils/h2ph.PL | 45 +- contrib/perl5/utils/h2xs.PL | 404 +- contrib/perl5/utils/perlbug.PL | 150 +- contrib/perl5/utils/perlcc.PL | 1450 +-- contrib/perl5/utils/perldoc.PL | 57 +- contrib/perl5/warnings.h | 74 +- contrib/perl5/warnings.pl | 289 +- contrib/perl5/x2p/EXTERN.h | 2 +- contrib/perl5/x2p/INTERN.h | 2 +- contrib/perl5/x2p/Makefile.SH | 12 +- contrib/perl5/x2p/a2p.c | 2 +- contrib/perl5/x2p/a2p.h | 3 +- contrib/perl5/x2p/a2p.y | 2 +- contrib/perl5/x2p/a2py.c | 2 +- contrib/perl5/x2p/cflags.SH | 4 +- contrib/perl5/x2p/find2perl.PL | 14 +- contrib/perl5/x2p/hash.c | 2 +- contrib/perl5/x2p/hash.h | 2 +- contrib/perl5/x2p/proto.h | 2 +- contrib/perl5/x2p/s2p.PL | 8 +- contrib/perl5/x2p/str.c | 2 +- contrib/perl5/x2p/str.h | 2 +- contrib/perl5/x2p/util.c | 2 +- contrib/perl5/x2p/util.h | 2 +- contrib/perl5/x2p/walk.c | 2 +- contrib/perl5/xsutils.c | 2 + 822 files changed, 63415 insertions(+), 24841 deletions(-) diff --git a/contrib/perl5/AUTHORS b/contrib/perl5/AUTHORS index f978b51bd895..331f3aff2443 100644 --- a/contrib/perl5/AUTHORS +++ b/contrib/perl5/AUTHORS @@ -1,120 +1,557 @@ -# Two sections: the real one and the virtual one. -# The real section has three \t+ fields: alias, name, email. -# The sections are separated by one or more empty lines. -# The virtual section (each record two \t+ separated fields) builds -# meta-aliases based on the real section. - -alan.burlison Alan Burlison Alan.Burlison@UK.Sun.com -allen Norton T. Allen allen@huarp.harvard.edu -bradapp Brad Appleton bradapp@enteract.com -cbail Charles Bailey bailey@newman.upenn.edu -dgris Daniel Grisinger dgris@dimensional.com -dmulholl Daniel Yacob dmulholl@cs.indiana.edu -dogcow Tom Spindler dogcow@merit.edu -domo Dominic Dunlop domo@slipper.ip.lu -doug Doug MacEachern dougm@pobox.com -doughera Andy Dougherty doughera@lafcol.lafayette.edu -gbarr Graham Barr gbarr@ti.com -gerti Gerd Knops gerti@BITart.com -gibreel Stephen Zander gibreel@pobox.com -gnat Nathan Torkington gnat@frii.com -gsar Gurusamy Sarathy gsar@activestate.com -hansmu Hans Mulder hansmu@xs4all.nl -ilya Ilya Zakharevich ilya@math.ohio-state.edu -jbuehler Joe Buehler jbuehler@hekimian.com -jfs John Stoffel jfs@fluent.com -jhi Jarkko Hietaniemi jhi@iki.fi -jon Jon Orwant orwant@media.mit.edu -jvromans Johan Vromans jvromans@squirrel.nl -k Andreas Koenig andreas.koenig@franz.ww.tu-berlin.de -kjahds Kenneth Albanowski kjahds@kjahds.com -krishna Krishna Sethuraman krishna@sgi.com -kstar Kurt D. Starsinic kstar@isinet.com -lstein Lincoln D. Stein lstein@genome.wi.mit.edu -lutherh Luther Huffman lutherh@stratcom.com -lutz Mark P. Lutz mark.p.lutz@boeing.com -lwall Larry Wall larry@wall.org -makemaker MakeMaker list makemaker@franz.ww.tu-berlin.de -mbiggar Mark A Biggar mab@wdl.loral.com -mbligh Martin J. Bligh mbligh@sequent.com -mike Mike Stok mike@stok.co.uk -millert Todd Miller millert@openbsd.org -laszlo.molnar Laszlo Molnar Laszlo.Molnar@eth.ericsson.se -mpeix Mark Bixby markb@cccd.edu -muir David Muir Sharnoff muir@idiom.com -neale Neale Ferguson neale@VMA.TABNSW.COM.AU -nik Nick Ing-Simmons nik@tiuk.ti.com -okamoto Jeff Okamoto okamoto@corp.hp.com -paul_green Paul Green Paul_Green@stratus.com -pmarquess Paul Marquess Paul.Marquess@btinternet.com -pomeranz Hal Pomeranz pomeranz@netcom.com -pudge Chris Nandor pudge@pobox.com -pueschel Norbert Pueschel pueschel@imsdd.meb.uni-bonn.de -pvhp Peter Prymmer pvhp@forte.com -raphael Raphael Manfredi Raphael_Manfredi@pobox.com -rdieter Rex Dieter rdieter@math.unl.edu -rsanders Robert Sanders Robert.Sanders@linux.org -roberto Ollivier Robert roberto@keltia.freenix.fr -roderick Roderick Schertler roderick@argon.org -roehrich Dean Roehrich roehrich@cray.com -tsanders Tony Sanders sanders@bsdi.com -schinder Paul Schinder schinder@pobox.com -scotth Scott Henry scotth@sgi.com -seibert Greg Seibert seibert@Lynx.COM -spider Spider Boardman spider@Orb.Nashua.NH.US -smccam Stephen McCamant smccam@uclink4.berkeley.edu -sugalskd Dan Sugalski sugalskd@osshe.edu -sundstrom David Sundstrom sunds@asictest.sc.ti.com -tchrist Tom Christiansen tchrist@perl.com -thomas.dorner Dorner Thomas Thomas.Dorner@start.de -timb Tim Bunce Tim.Bunce@ig.co.uk -tom.horsley Tom Horsley Tom.Horsley@mail.ccur.com -tye Tye McQueen tye@metronet.com -wayne.thompson Wayne Thompson Wayne.Thompson@Ebay.sun.com - -PUMPKING gsar -aix jhi -amiga pueschel -beos dogcow -bsdos tsanders -cfg jhi -cgi lstein -complex jhi,raphael -cpan k -cxux tom.horsley -cygwin win32 -dec_osf jhi,spider -dgux roderick -doc tchrist -dos laszlo.molnar -dynix/ptx mbligh -ebcdic vms,vmesa,posixbc -filespec kjahds -freebsd roberto -hpux okamoto,jhi -irix scotth,krishna,jfs,kstar -jpl gibreel -linux kjahds,kstar -locale jhi,domo -lynxos lynxos -machten domo -mm makemaker -mvs pvhp -netbsd jhi -openbsd millert -os2 ilya -plan9 lutherl -posix-bc thomas.dorner -powerux tom.horsley -qnx allen -solaris doughera,alan.burlison -step gerti,hansmu,rdieter -sunos4 doughera -svr4 tye -unicos jhi,lutz -uwin jbuehler -vmesa neale -vms sugalskd,cbail -vos paul_green -warn pmarquess -win32 gsar +# To give due honor to those who have made Perl 5 what is is today, +# here are easily-from-changelogs-extractable people and their +# (hopefully) current and preferred email addresses (as of late 2000 +# if known) from the Changes files. These people have either submitted +# patches or suggestions, or their bug reports or comments have inspired +# the appropriate patches. Corrections, additions, deletions welcome. +# +-- +Aaron B. Dossett +Abigail +Achim Bohnet +Adam Krolnik +Akim Demaille +Alan Burlison +Alan Champion +Alan Harder +Alan Modra +Albert Chin-A-Young +Albert Dvornik +Alexander Smishlajev +Allen Smith +Ambrose Kofi Laing +Andreas Klussmann +Andreas König +Andreas Schwab +Andrew Bettison +Andrew Cohen +Andrew M. Langmead +Andrew Pimlott +Andrew Vignaux +Andrew Wilcox +Andy Dougherty +Anno Siegel +Anthony David +Anton Berezin +Art Green +Artur +Barrie Slaymaker +Barry Friedman +Ben Tilly +Benjamin Low +Benjamin Stuhl +Benjamin Sugars +Bernard Quatermass +Bill Campbell +Bill Glicker +Billy Constantine +Blair Zajac +Boyd Gerber +Brad Appleton +Brad Howerter +Brad Hughes +Brad Lanam +Brent B. Powers +Brian Callaghan +Brian Clarke +Brian Grossman +Brian Harrison +Brian Jepson +Brian Katzung +Brian Reichert +Brian S. Cashman +Bruce Barnett +Bruce J. Keeler +Bruce P. Schuck +Bud Huff +Byron Brummer +Calle Dybedahl +Carl M. Fongheiser +Carl Witty +Cary D. Renzema +Casey R. Tweten +Castor Fu +Chaim Frenkel +Charles Bailey +Charles F. Randall +Charles Lane +Charles Wilson +Chip Salzenberg +Chris Faylor +Chris Nandor +Chris Wick +Christian Kirsch +Christopher Chan-Nui +Christopher Davis +Chuck D. Phillips +Chuck Phillips +Chunhui Teng +Clark Cooper +Clinton Pierce +Colin Kuskie +Conrad Augustin +Conrad E. Kimball +Craig A. Berry +Craig Milo Rogers +Dale Amon +Damian Conway +Damon Atkins +Dan Boorstein +Dan Carson +Dan Schmidt +Dan Sugalski +Daniel Chetlin +Daniel Grisinger +Daniel Muiño +Daniel S. Lewart +Daniel Yacob +Danny R. Faught +Danny Sadinoff +Darrell Kindred +Darrell Schiebel +Darren/Torin/Who Ever... +Dave Bianchi +Dave Hartnoll +Dave Nelson +Dave Schweisguth +David Billinghurst +David Campbell +David Couture +David Denholm +David Dyck +David F. Haertig +David Filo +David Glasser +David Hammen +David J. Fiander +David Kerry +David Muir Sharnoff +David R. Favor +David Sparks +David Starks-Browning +David Sundstrom +Davin Milun +Dean Roehrich +Dennis Marsa +dive +Dominic Dunlop +Dominique Dumont +Doug Campbell +Doug MacEachern +Douglas E. Wegscheid +Douglas Lankshear +Dov Grobgeld +Drago Goricanec +Ed Mooring +Ed Peschko +Elaine -HFB- Ashton +Eric Arnold +Eric Bartley +Eric E. Coe +Eric Fifer +Erich Rickheit +Eryq +Etienne Grossman +Eugene Alterman +Fabien Tassin +Felix Gallo +Florent Guillaume +Frank Crawford +Frank Ridderbusch +Frank Tobin +François Désarménien +Fréderic Chauveau +G. Del Merritt +Gabe Schaffer +Gary Clark +Gary Ng <71564.1743@compuserve.com> +Gerben Wierda +Gerd Knops +Giles Lean +Gisle Aas +Gordon J. Miller +Grace Lee +Graham Barr +Graham TerMarsch +Greg Bacon +Greg Chapman +Greg Earle +Greg Kuperberg +Greg Seibert +Greg Ward +Gregory Martin Pfeil +Guenter Schmidt +Guido Flohr +Gurusamy Sarathy +Gustaf Neumann +Guy Decoux +H.J. Lu +H.Merijn Brand +Hal Pomeranz +Hallvard B Furuseth +Hannu Napari +Hans Mulder +Hans de Graaff +Harold O Morris +Harry Edmon +Helmut Jarausch +Henrik Tougaard +Hershel Walters +Holger Bechtold +Horst von Brand +Hubert Feyrer +Hugo van der Sanden +Hunter Kelly +Huw Rogers +Ian Maloney +Ian Phillipps +Ignasi Roca +Ilya Sandler +Ilya Zakharevich +Inaba Hiroto +Irving Reid +J. David Blackstone +J. van Krieken +JD Laub +JT McDuffie +Jack Shirazi +Jacqui Caren +Jake Hamby +James FitzGibbon +Jamshid Afshar +Jan D. +Jan Dubois +Jan Pazdziora +Jan-Erik Karlsson +Jan-Pieter Cornet +Jared Rhine +Jarkko Hietaniemi +Jason A. Smith +Jason Shirk +Jason Stewart +Jason Varsoke +Jay Rogers +Jeff Bouis +Jeff McDougal +Jeff Okamoto +Jeff Pinyan +Jeff Urlwin +Jeffrey Friedl +Jeffrey S. Haemer +Jens Hamisch +Jens T. Berger Thielemann +Jens Thomsen +Jens-Uwe Mager +Jeremy D. Zawodny +Jerome Abela +Jim Anderson +Jim Avera +Jim Balter +Jim Meyering +Jim Miner +Jim Richardson +Joachim Huober +Jochen Wiedmann +Joe Buehler +Joe Smith +Joel Rosi-Schwartz +Joerg Porath +Joergen Haegg +Johan Holtman +Johan Vromans +Johann Klasek +John Bley +John Borwick +John Cerney +John D Groenveld +John Hasstedt +John Hughes +John L. Allen +John Macdonald +John Nolan +John Peacock +John Pfuntner +John Rowe +John Salinas +John Stoffel +John Tobey +Jon Orwant +Jonathan Biggar +Jonathan D Johnston +Jonathan Fine +Jonathan I. Kamens +Jonathan Roy +Joseph N. Hall +Joseph S. Myers +Joshua Pritikin +Juan Gallego +Julian Yip +Justin Banks +Ka-Ping Yee +Karl Glazebrook +Karl Heuer +Karl Simon Berg +Karsten Sperling +Kaveh Ghazi +Keith Neufeld +Keith Thompson +Ken Estes +Ken Fox +Ken MacLeod +Ken Shan +Kenneth Albanowski +Kenneth Duda +Keong Lim +Kevin O'Gorman +Kevin White +Kim Frutiger +Kragen Sitaker +Krishna Sethuraman +Kurt D. Starsinic +Kyriakos Georgiou +Larry Parmelee +Larry Schuler +Larry Schwimmer +Larry W. Virden +Larry Wall +Lars Hecking +Laszlo Molnar +Len Johnson +Les Peters +Lincoln D. Stein +Lionel Cons +Luca Fini +Lupe Christoph +Luther Huffman +M. J. T. Guy +Major Sébastien +Makoto MATSUSHITA +Malcolm Beattie +Marc Lehmann +Marc Paquette +Marcel Grunauer +Mark A Biggar +Mark Bixby +Mark Dickinson +Mark Hanson +Mark K Trettin +Mark Kaehny +Mark Kettenis +Mark Klein +Mark Knutsen +Mark Kvale +Mark Leighton Fisher +Mark Murray +Mark P. Lutz +Mark Pease +Mark Pizzolato +Mark R. Levinson +Mark-Jason Dominus +Martijn Koster +Martin J. Bligh +Martin Jost +Martin Lichtin +Martin Plechsmid +Marty Lucich +Martyn Pearce +Masahiro KAJIURA +Mathias Koerber +Matt Kimball +Matthew Black +Matthew Green +Matthew T Harden +Matthias Ulrich Neeracher +Matthias Urlichs +Maurizio Loreti +Michael Cook +Michael De La Rue +Michael Engel +Michael G Schwern +Michael H. Moran +Michael Mahan +Michael Stevens +Michele Sardo +Mik Firestone +Mike Fletcher +Mike Hopkirk +Mike Rogers +Mike Stok +Mike W Ellwood +Milton Hankins +Milton L. Hankins +Molnar Laszlo +Murray Nesbitt +Nathan Kurz +Nathan Torkington +Neale Ferguson +Neil Bowers +Nicholas Clark +Nick Duffek +Nick Gianniotis +Nick Ing-Simmons +Norbert Pueschel +Norton T. Allen +Olaf Flebbe +Olaf Titz +Ollivier Robert +Owen Taylor +Patrick Hayes +Patrick O'Brien +Paul A Sand +Paul David Fardy +Paul Green +Paul Hoffman +Paul Holser +Paul Johnson +Paul Marquess +Paul Moore +Paul Rogers +Paul Saab +Paul Schinder +Pete Peterson +Peter Chines +Peter Gordon +Peter Haworth +Peter J. Farley III +Peter Jaspers-Fayer +Peter Prymmer +Peter Scott +Peter Wolfe +Peter van Heusden +Petter Reinholdtsen +Phil Lobbes +Philip Hazel +Philip Newton +Piers Cawley +Piotr Klaban +Prymmer/Kahn +Quentin Fennessy +Radu Greab +Ralf S. Engelschall +Randal L. Schwartz +Randy J. Ray +Raphael Manfredi +Raymund Will +Rex Dieter +Rich Morin +Rich Salz +Richard A. Wells +Richard Foley +Richard L. England +Richard L. Maus, Jr. +Richard Soderberg +Richard Yeh +Rick Delaney +Rick Pluta +Rickard Westman +Rob Henderson +Robert Partington +Robert Sanders +Robert Spier +Robin Barker +Robin Houston +Rocco Caputo +Roderick Schertler +Rodger Anderson +Ronald F. Guilmette +Ronald J. Kimball +Ruben Schattevoy +Rujith S. de Silva +Russ Allbery +Russell Fulton +Russell Mosemann +Ryan Herbert +SAKAI Kiyotaka +Samuli Kärkkäinen +Scott Gifford +Scott Henry +Sean Robinson +Sean Sheedy +Sebastien Barre +Shigeya Suzuki +Shimpei Yamashita +Shishir Gundavaram +Simon Cozens +Simon Leinen +Simon Parsons +Slaven Rezic +Spider Boardman +Stephane Payrard +Stephanie Beals +Stephen McCamant +Stephen O. Lidie +Stephen P. Potter +Stephen Zander +Steve A Fink +Steve Kelem +Steve McDougall +Steve Nielsen +Steve Pearlmutter +Steve Vinoski +Steven Hirsch +Steven Knight +Steven Morlock +Steven N. Hirsch +Steven Parkes +Sven Verdoolaege +SynaptiCAD, Inc. +Taro KAWAGISHI +Ted Ashton +Ted Law +Teun Burgers +Thad Floryan +Thomas Bowditch +Thomas Conté +Thomas Dorner +Thomas Kofler +Thomas König +Tim Adye +Tim Ayers +Tim Bunce +Tim Conrow +Tim Freeman +Tim Jenness +Tim Mooney +Tim Witham +Timur I. Bakeyev +Tkil +Todd C. Miller +Tom Bates +Tom Christiansen +Tom Horsley +Tom Hughes +Tom Phoenix +Tom Spindler +Tony Camas +Tony Cook +Tony Sanders +Tor Lillqvist +Trevor Blackwell +Tuomas J. Lukka +Tye McQueen +Ulrich Kunitz +Ulrich Pfeifer +Vadim Konovalov +Valeriy E. Ushakov +Vishal Bhatia +Vlad Harchev +Vladimir Alexiev +W. Phillip Moore +Warren Hyde +Warren Jones +Wayne Berke +Wayne Scott +Wayne Thompson +Wilfredo Sánchez +William J. Middleton +William Mann +William R Ward +William Setzer +Winfried König +Wolfgang Laun +Yary Hluchan +Yasushi Nakajima +Yitzchak Scott-Thoennes +Yutaka OIWA +Yutao Feng +Zachary Miller diff --git a/contrib/perl5/Changes b/contrib/perl5/Changes index 69498211964c..725d2915be51 100644 --- a/contrib/perl5/Changes +++ b/contrib/perl5/Changes @@ -5,76 +5,7 @@ patches posted to the perl5-porters mailing list. Patches for each individual change may also be obtained through ftp and rsync--see perlhack.pod for the details. - - --------------- - CAST AND CREW - --------------- - -To give due honor to those who have made Perl what is is today, -here are some of the more common names in the Changes file, and their -current addresses (as of February 2000): - - Gisle Aas - Abigail - Kenneth Albanowski - Russ Allbery - Brad Appleton - Greg Bacon - Robin Barker - Vishal Bhatia - Spider Boardman - Tom Christiansen - Mark-Jason Dominus - Jan Dubois - Dominic Dunlop - Eric Fifer - Hallvard B Furuseth - M. J. T. Guy - Jarkko Hietaniemi - Tom Hughes - Nick Ing-Simmons - Andreas Koenig - Douglas Lankshear - Doug MacEachern - Raphael Manfredi - Paul Marquess - Stephen McCamant - Laszlo Molnar - Hans Mulder - Chris Nandor - Matthias Neeracher - Jeff Okamoto - Ulrich Pfeifer - Tom Phoenix - Joshua Pritikin - Peter Prymmer - Norbert Pueschel - Dean Roehrich - Hugo van der Sanden - Michael G Schwern - Roderick Schertler - Kurt D. Starsinic - Benjamin Stuhl - Dan Sugalski - Nathan Torkington - Larry W. Virden - Johan Vromans - Ilya Zakharevich - -And the Keepers of the Patch Pumpkin: - - Charles Bailey - Graham Barr - Malcolm Beattie - Tim Bunce - Andy Dougherty - Gurusamy Sarathy - Chip Salzenberg - -And, of course, the Author of Perl: - - Larry Wall - +[The "CAST AND CREW" list has been moved to AUTHORS.] NOTE: Each change entry shows the change number; who checked it into the repository; when; description of the change; which branch the change @@ -87,6 +18,7324 @@ indicator: +> branched (from elsewhere) !> merged changes (from elsewhere) +The Message-Ids in the change entries refer to the email messages sent +to the perl5-porters mailing list. You can retrieve the messages for +example from http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/ + +This file contains only changes that affect the maint-5.6 branch. +Cross-references to changes imported from other branches (principally, +the mainline) are indicated by change numbers. Detailed log entries +corresponding to these change numbers are available in the Changes +file in the latest development release. + + +-------------- +Version v5.6.1 +-------------- + +____________________________________________________________________________ +[ 9651] By: gsar on 2001/04/09 03:11:19 + Log: update Changes, patchlevel.h &c. + Branch: maint-5.6/perl + ! Changes patchlevel.h pod/perldelta.pod pod/perlhist.pod + ! pod/perltoc.pod +____________________________________________________________________________ +[ 9649] By: gsar on 2001/04/09 02:35:43 + Log: tweak perldelta as suggested by Jarkko + Branch: maint-5.6/perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 9646] By: gsar on 2001/04/09 00:48:04 + Log: add note about ithreads and Thread.pm (too many people are + confused by the fact that Thread.pm is built and installed + under non-5005threads but doesn't work) + Branch: maint-5.6/perl + ! ext/Thread/Thread.pm ext/Thread/Thread.xs +____________________________________________________________________________ +[ 9645] By: gsar on 2001/04/09 00:19:03 + Log: update perldelta.pod for changes in 5.6.1 + Branch: maint-5.6/perl + ! Changes pod/perldelta.pod +____________________________________________________________________________ +[ 9640] By: gsar on 2001/04/08 19:20:46 + Log: integrate change#9634 from mainline + + Fix the perlmodlib generation (didn't understand separate .pod + files; didn't understand -- as the name-thing separator). + Update the CPAN mirrors list. + Branch: maint-5.6/perl + ! pod/perlmodlib.pod + !> pod/perlmodlib.PL +____________________________________________________________________________ +[ 9639] By: gsar on 2001/04/08 18:57:31 + Log: on windows, many of the README.* pods were being copied to the wrong + location + Branch: maint-5.6/perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 9638] By: gsar on 2001/04/08 18:38:25 + Log: update to latest JPL from the anoncvs repository + Branch: maint-5.6/perl + + jpl/ChangeLog jpl/README.JUST-JNI jpl/docs/Tutorial.pod + ! MANIFEST jpl/JNI/JNI.pm jpl/JNI/JNI.xs jpl/JNI/Makefile.PL + ! jpl/PerlInterpreter/PerlInterpreter.h jpl/README +____________________________________________________________________________ +[ 9632] By: gsar on 2001/04/08 16:36:06 + Log: add $Tie::RefHash::VERSION + Branch: maint-5.6/perl + ! lib/Tie/RefHash.pm +____________________________________________________________________________ +[ 9624] By: gsar on 2001/04/08 06:08:17 + Log: test in t/pod/* were busted + + these tests are still not enabled in t/{harness,TEST} + Branch: maint-5.6/perl + ! lib/Pod/Find.pm t/pod/emptycmd.t t/pod/find.t t/pod/for.t + ! t/pod/headings.t t/pod/include.t t/pod/included.t t/pod/lref.t + ! t/pod/multiline_items.t t/pod/nested_items.t + ! t/pod/nested_seqs.t t/pod/oneline_cmds.t t/pod/pod2usage.t + ! t/pod/poderrs.t t/pod/podselect.t t/pod/special_seqs.t +____________________________________________________________________________ +[ 9623] By: gsar on 2001/04/08 03:37:01 + Log: integrate change#9470 from mainline + + Subject: Re: [ID 20010215.006] Bad arg length for Socket::unpack_sockaddr_un, length is 14 ... + Branch: maint-5.6/perl + !> ext/Socket/Socket.xs +____________________________________________________________________________ +[ 9605] By: gsar on 2001/04/07 11:52:40 + Log: can't optimize away scope entry if tr/// is present + Branch: maint-5.6/perl + ! op.c t/op/tr.t +____________________________________________________________________________ +[ 9597] By: gsar on 2001/04/06 18:06:35 + Log: integrate change#9464 from mainline (addendum to change#8313) + + Subject: [PATCH @9452] Better peep()ing for foreach() loops + Branch: maint-5.6/perl + !> op.c +____________________________________________________________________________ +[ 9595] By: gsar on 2001/04/06 14:57:17 + Log: add a low-impact fix to accomodate darwin-ism + Branch: maint-5.6/perl + ! ext/Errno/Errno_pm.PL +____________________________________________________________________________ +[ 9594] By: jhi on 2001/04/06 14:55:14 + Log: Integrate changes #9528,9593 from mainline into maintperl; + tweaking the editor/IDE/shell list. + Branch: maint-5.6/perl + !> pod/perlfaq3.pod +____________________________________________________________________________ +[ 9592] By: gsar on 2001/04/06 14:45:18 + Log: integrate change#9477 from mainline (base.pm doc tweak) + + missing doc entry for fmod() + Branch: maint-5.6/perl + ! lib/Math/BigFloat.pm + !> lib/base.pm +____________________________________________________________________________ +[ 9587] By: gsar on 2001/04/06 07:31:30 + Log: add README.macos (from Chris Nandor) + + tyop in change#9555 + Branch: maint-5.6/perl + + README.macos + ! MANIFEST pod/buildtoc.PL pod/perl.pod pod/perlfaq9.pod + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 9586] By: gsar on 2001/04/06 07:08:54 + Log: fixes for Math::BigFloat bugs; add fmod() (from John Peacock) + Branch: maint-5.6/perl + ! lib/Math/BigFloat.pm t/lib/bigfltpm.t +____________________________________________________________________________ +[ 9585] By: gsar on 2001/04/06 06:58:44 + Log: integrate changes#9555,9556,9563..9567,9570..9575,9577..9578 + from mainline + + Subject: [PATCH] Base64 update to perlfaq9.pod + + Subject: [PATCH AUTHORS] Housekeeping + + Subject: Re: Not OK: perl v5.6.1 +fools-gold on darwin 1.3 (UNINSTALLED) + Mac OS X (Darwin) has extra pwent fields. + + Subject: [PATCH B::*] print control-character vars readably + Needs EBCDICification. + + Subject: [PATCH B::Deparse] lexical variables with ridiculously long names that are used in list assignments + + Subject: [PATCH B::*] cope with SVf_IVisUV, and cope with $^^ and friends + + Subject: [PATCH B::Deparse] "${foo}bar", "${foo}[1]" etc. + + Subject: [PATCH B::Deparse] binmode is no longer an UNOP + + Subject: [PATCH B::Deparse] regex quoting, and a minor milestone + + Subject: [PATCH B::Deparse] suppress "unintialized value" warnings + + Subject: bleadperl / hex ignores variable length and/or tr doesn't null terminate ( with patch) + + Subject: patch for t/op/oct.t that shows need for patch supplied with bug 20010404.009, (bugs in hex and oct) + + FreeBSD hints tweak from Anton Berezin. + + Subject: [PATCH foolperl & bleadperl] README.vms update + + Subject: Re: [PATCH foolperl & bleadperl] README.vms update + Branch: maint-5.6/perl + !> AUTHORS README.vms ext/B/B.pm ext/B/B/Concise.pm + !> ext/B/B/Debug.pm ext/B/B/Deparse.pm ext/B/B/Terse.pm + !> hints/freebsd.sh pod/perlfaq9.pod pp.c t/op/oct.t t/op/pwent.t +____________________________________________________________________________ +[ 9584] By: gsar on 2001/04/06 04:09:00 + Log: keep eval"" CVs alive until the end of the statement in which + they're called; this avoids a coredump ensuing from search for + lexicals in code such as: + + sub bug { + my $s = @_; + eval q[sub { eval 'sub { &$s }' }]; + } + bug("x")->()->(); + + this code still doesn't work as intended (as it has remained + since time immemorial), but it doesn't provoke a coredump anymore + Branch: maint-5.6/perl + ! embed.h embed.pl global.sym objXSUB.h perlapi.c + ! pod/perlguts.pod pp_ctl.c proto.h scope.c scope.h sv.c +____________________________________________________________________________ +[ 9551] By: gsar on 2001/04/05 00:18:34 + Log: tr/// doesn't null-terminate the result in some situations + (from Gisle Aas) + Branch: maint-5.6/perl + ! doop.c t/op/tr.t +____________________________________________________________________________ +[ 9550] By: gsar on 2001/04/04 20:04:17 + Log: B::Deparse fix for ${^FOO} and documentation for PVX() method + (from Robin Houston) + Branch: maint-5.6/perl + ! ext/B/B.pm ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 9548] By: gsar on 2001/04/04 18:51:49 + Log: integrate changes#9460,9462,9482,9521,9522 + + Subject: PATCH: B::Debug should show LOOP-specific fields + + Subject: B::Deparse precedence bug. (Patch included.) + + Subject: Re: [ID 20010330.003] O=Deparse,-p does not preserve "operational semantics" + + Subject: [PATCH B::Concise] @stash_array = split(/pat/, str); + + Subject: [PATCH B::Concise] padname values may have bogus SvCUR + Branch: maint-5.6/perl + !> ext/B/B.pm ext/B/B.xs ext/B/B/Concise.pm ext/B/B/Debug.pm + !> ext/B/B/Deparse.pm ext/B/B/Showlex.pm +____________________________________________________________________________ +[ 9547] By: gsar on 2001/04/04 18:49:16 + Log: s/djSP/dSP/ + Branch: maint-5.6/perl + ! ext/Thread/Thread.xs +____________________________________________________________________________ +[ 9545] By: gsar on 2001/04/04 18:38:52 + Log: integrate change#8837 from mainline + + Subject: [patch] -Wall cleanup round 2 + Branch: maint-5.6/perl + !> ext/B/B.xs ext/Data/Dumper/Dumper.xs ext/Devel/DProf/DProf.xs + !> ext/Devel/Peek/Peek.xs ext/Fcntl/Fcntl.xs + !> ext/File/Glob/Glob.xs ext/GDBM_File/GDBM_File.xs ext/IO/IO.xs + !> ext/IPC/SysV/SysV.xs ext/Opcode/Opcode.xs ext/POSIX/POSIX.xs + !> ext/SDBM_File/SDBM_File.xs +____________________________________________________________________________ +[ 9544] By: gsar on 2001/04/04 17:49:57 + Log: "double" should be "NV"; standard typemap is missing entry + for NV + Branch: maint-5.6/perl + ! ext/B/B.xs ext/B/B/C.pm lib/ExtUtils/typemap +____________________________________________________________________________ +[ 9539] By: gsar on 2001/04/04 03:01:14 + Log: another tweak needed for SunOS 4.1.x build (from Mike Guy) + Branch: maint-5.6/perl + ! Makefile.SH +____________________________________________________________________________ +[ 9538] By: gsar on 2001/04/04 01:00:38 + Log: fflush() is a macro on SunOS 4.1.x, so provide a wrapper + for use with _fwalk() (fix for change#7705) + Branch: maint-5.6/perl + ! util.c +____________________________________________________________________________ +[ 9533] By: gsar on 2001/04/03 14:30:07 + Log: better fix for change#9517 to accomodate UNC paths like + \\server\share\foo, and paths with trailing backslash + like c:\this\ + Branch: maint-5.6/perl + ! utils/perldoc.PL x2p/find2perl.PL x2p/s2p.PL +____________________________________________________________________________ +[ 9530] By: gsar on 2001/04/03 04:56:41 + Log: accomodate VMS "mailbox overflow" quirk in testsuite (from + Craig Berry) + Branch: maint-5.6/perl + ! t/lib/socket.t +____________________________________________________________________________ +[ 9524] By: gsar on 2001/04/03 01:09:12 + Log: EPOC fix for lib/io_udp.t failure (from Olaf Flebbe) + Branch: maint-5.6/perl + ! pp_sys.c +____________________________________________________________________________ +[ 9517] By: gsar on 2001/04/02 19:52:21 + Log: many of the utilities interpolate literal paths within doublequotes + (fails on dosish platforms where path contains backslashes) + Branch: maint-5.6/perl + ! utils/perldoc.PL x2p/find2perl.PL x2p/s2p.PL +____________________________________________________________________________ +[ 9516] By: gsar on 2001/04/02 05:49:37 + Log: a foolish release + Branch: maint-5.6/perl + ! Changes patchlevel.h pod/perldelta.pod pod/perlhist.pod + ! pod/perltoc.pod +____________________________________________________________________________ +[ 9515] By: gsar on 2001/04/02 05:04:29 + Log: add missing changelog summaries + Branch: maint-5.6/perl + ! Changes +____________________________________________________________________________ +[ 9514] By: gsar on 2001/04/02 04:07:13 + Log: add some notes about gutsy threading matters + Branch: maint-5.6/perl + ! pod/perlguts.pod +____________________________________________________________________________ +[ 9513] By: gsar on 2001/04/02 03:25:21 + Log: add more prominent caveat notices about experimental features + Branch: maint-5.6/perl + ! pod/perlfork.pod pod/perlunicode.pod +____________________________________________________________________________ +[ 9512] By: gsar on 2001/04/02 02:54:33 + Log: integrate changes#9479,9509 from mainline + + [PATCH] File::Glob stuff for Mac OS + + [PATH bsd_glob.c perl@9472] Shut up gcc warning in bsd_glob.c + Branch: maint-5.6/perl + !> ext/File/Glob/Glob.pm ext/File/Glob/bsd_glob.c + !> t/lib/glob-basic.t t/lib/glob-case.t t/lib/glob-global.t + !> t/lib/glob-taint.t +____________________________________________________________________________ +[ 9511] By: gsar on 2001/04/02 02:38:24 + Log: README.win32 tweaks; add a note about alternative location for + getting a gcc-2.95.2 that will build perl properly on windows + Branch: maint-5.6/perl + ! README.win32 +____________________________________________________________________________ +[ 9507] By: jhi on 2001/04/01 19:24:01 + Log: Integrate changes #9378,9458,9469,9475,9489,9490,9505,9506 + from mainline to maintperl: pod tweaks. + Branch: maint-5.6/perl + !> pod/perldebug.pod pod/perldiag.pod pod/perlfaq1.pod + !> pod/perlguts.pod pod/perlhack.pod pod/perlop.pod + !> pod/perlvar.pod +____________________________________________________________________________ +[ 9501] By: gsar on 2001/04/01 07:21:57 + Log: fix the perlembed notes on multiple interpreters + + fix ExtUtils::Embed to work passably on Windows + Branch: maint-5.6/perl + ! lib/ExtUtils/Embed.pm pod/perlembed.pod +____________________________________________________________________________ +[ 9496] By: gsar on 2001/03/31 23:22:28 + Log: various nits identified by the Borland 5.5 compiler; remove suppression + of a few warnings + Branch: maint-5.6/perl + ! ext/File/Glob/bsd_glob.c sv.c win32/win32.h +____________________________________________________________________________ +[ 9495] By: gsar on 2001/03/31 21:03:08 + Log: avoid redefinition warnings under Borland 5.02 + Branch: maint-5.6/perl + ! win32/makefile.mk +____________________________________________________________________________ +[ 9494] By: gsar on 2001/03/31 20:18:59 + Log: nits spotted by Borland compiler + Branch: maint-5.6/perl + ! utf8.h win32/win32.h +____________________________________________________________________________ +[ 9493] By: gsar on 2001/03/31 20:18:05 + Log: fix a broken workaround for Borland compiler in change#4739 + (caused weird "short reads" on DATA, which caused op/misc.t to fail) + Branch: maint-5.6/perl + ! toke.c +____________________________________________________________________________ +[ 9491] By: gsar on 2001/03/31 17:01:56 + Log: Cwd::chdir() doesn't set $ENV{PWD} correctly on windows when the + directory is relative (need to fetch the full path name *before* + the chdir!) + + this is a followup patch for change#6749 + Branch: maint-5.6/perl + ! lib/Cwd.pm +____________________________________________________________________________ +[ 9426] By: gsar on 2001/03/29 00:28:04 + Log: dmake can only handle == and != in comparisons; support building + with Borland's VCL libraries (from Vadim Konovalov) + Branch: maint-5.6/perl + ! win32/makefile.mk +____________________________________________________________________________ +[ 9416] By: jhi on 2001/03/28 18:06:07 + Log: Integrate change #9409 from mainline to maintperl. + + Yet another tweak on AIX dynaloading. + Branch: maint-5.6/perl + !> ext/DynaLoader/dl_aix.xs ext/DynaLoader/hints/aix.pl +____________________________________________________________________________ +[ 9415] By: gsar on 2001/03/28 17:13:01 + Log: integrate changes#9377,9385,9401 from mainline + + Subject: RE: 5.6.0 BUG: Lexical warnings aren't lexical + + If directory entries compare equal case-insensitively, + retry case-sensitively. + + Subject: [PATCH] B::Terse and warnings + Branch: maint-5.6/perl + !> ext/B/B.pm ext/B/B/Terse.pm ext/File/Glob/bsd_glob.c gv.c + !> t/pragma/warn/perl +____________________________________________________________________________ +[ 9312] By: gsar on 2001/03/23 16:25:25 + Log: add execute bit to files with shebang lines in the repository; + avoid clobbering execute bit in Porting/makerel + Branch: maint-5.6/perl + ! (edit 144 files) +____________________________________________________________________________ +[ 9306] By: jhi on 2001/03/23 12:51:36 + Log: There are AIXes without /usr/include/load.h, + patch from H.Merijn Brand. + Branch: maint-5.6/perl + ! ext/DynaLoader/hints/aix.pl +____________________________________________________________________________ +[ 9299] By: gsar on 2001/03/22 16:53:45 + Log: back out changes#7532,7521 for now (appears to have problems + on IRIX) + Branch: maint-5.6/perl + ! ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs + ! ext/POSIX/typemap pod/perlvar.pod +____________________________________________________________________________ +[ 9292] By: gsar on 2001/03/22 07:12:00 + Log: integrate changes#8306,8532 from mainline (missing USE_PURE_BISON + fixes) + Branch: maint-5.6/perl + !> embed.h embed.pl objXSUB.h perlapi.c perly.y proto.h toke.c +____________________________________________________________________________ +[ 9290] By: jhi on 2001/03/22 05:57:01 + Log: Move MacOS Classic higher in the list of supported platforms. + Branch: maint-5.6/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 9289] By: gsar on 2001/03/22 05:35:04 + Log: revert part of change#6438 for compatibility (av_reify() + appears to be needed to implement av_splice()ish things + in XS) + Branch: maint-5.6/perl + ! embed.pl global.sym objXSUB.h perlapi.c +____________________________________________________________________________ +[ 9288] By: gsar on 2001/03/22 03:09:19 + Log: update copyright year + Branch: maint-5.6/perl + ! EXTERN.h INTERN.h README av.c av.h cop.h cv.h deb.c doio.c + ! doop.c dump.c form.h gv.c gv.h handy.h hv.c hv.h mg.c mg.h + ! op.c op.h perl.c perl.h perlio.c perly.y pp.c pp.h pp_ctl.c + ! pp_hot.c pp_sys.c regcomp.c regexec.c run.c scope.c sv.c sv.h + ! toke.c utf8.c utf8.h util.c util.h x2p/EXTERN.h x2p/INTERN.h + ! x2p/a2p.c x2p/a2p.h x2p/a2p.y x2p/a2py.c x2p/hash.c x2p/hash.h + ! x2p/proto.h x2p/str.c x2p/str.h x2p/util.c x2p/util.h + ! x2p/walk.c +____________________________________________________________________________ +[ 9286] By: gsar on 2001/03/21 19:49:54 + Log: makefile.mk tweak + Branch: maint-5.6/perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 9283] By: jhi on 2001/03/21 17:17:35 + Log: Integrate change #9282 from mainline into maintperl, + 4-arg UTF-8 substr(). + Branch: maint-5.6/perl + !> pp.c +____________________________________________________________________________ +[ 9281] By: gsar on 2001/03/21 17:03:14 + Log: makefile.mk defaults to GCC, not BORLAND (as mentioned in README.win32) + Branch: maint-5.6/perl + ! win32/makefile.mk +____________________________________________________________________________ +[ 9280] By: gsar on 2001/03/21 17:01:20 + Log: some tweaks to change#9278 (fork() emulation should be enabled + by setting BUILD_FLAVOR instead of changing the defaults) + Branch: maint-5.6/perl + ! win32/makefile.mk +____________________________________________________________________________ +[ 9279] By: gsar on 2001/03/21 16:47:19 + Log: integrate change#9271 from mainline; a tweak to Glob.pm docs + Branch: maint-5.6/perl + ! ext/File/Glob/Glob.pm + !> lib/Cwd.pm +____________________________________________________________________________ +[ 9278] By: jhi on 2001/03/21 14:35:10 + Log: Subject: [PATCH: 5.6.1-trial3] Borland C++ for Win32 fixes + From: "Vadim Konovalov" + Date: Wed, 21 Mar 2001 01:53:51 +0300 + Message-ID: <004101c0b190$a749ea20$f7c030d4@vad> + Branch: maint-5.6/perl + ! win32/makefile.mk win32/win32sck.c +____________________________________________________________________________ +[ 9277] By: jhi on 2001/03/21 13:58:28 + Log: Integrate change #9270 from mainline to maintperl: + continued 4-arg UTF-8 substr() fixing. + Branch: maint-5.6/perl + !> pp.c t/op/substr.t +____________________________________________________________________________ +[ 9266] By: gsar on 2001/03/20 19:16:43 + Log: VMS piping fixes (from Charles Lane) + Branch: maint-5.6/perl + ! vms/vms.c vms/vmspipe.com +____________________________________________________________________________ +[ 9265] By: gsar on 2001/03/20 17:53:52 + Log: cut-n-paste goof in change#9264 + Branch: maint-5.6/perl + ! ext/File/Glob/Glob.xs +____________________________________________________________________________ +[ 9264] By: gsar on 2001/03/20 17:43:47 + Log: do alphabetical sorting by default (for csh compatibility); + bsd_glob() does ASCII sort by default as usual, unless + GLOB_ALPHASORT was specified + Branch: maint-5.6/perl + ! ext/File/Glob/Changes ext/File/Glob/Glob.pm + ! ext/File/Glob/Glob.xs ext/File/Glob/bsd_glob.c + ! ext/File/Glob/bsd_glob.h +____________________________________________________________________________ +[ 9263] By: gsar on 2001/03/20 16:40:08 + Log: integrate change#9255 from mainline (unicode fix) + + substr($bytestr, i, n, $charstr) + Branch: maint-5.6/perl + !> Todo-5.6 pp.c t/op/substr.t +____________________________________________________________________________ +[ 9262] By: gsar on 2001/03/20 15:57:41 + Log: revert the leak fix in change#9142 (problem needs a more experimental + fix unsuitable for 5.6.1) + Branch: maint-5.6/perl + ! scope.c +____________________________________________________________________________ +[ 9260] By: jhi on 2001/03/20 14:05:46 + Log: Subject: [PATCH perl-5.6.1-TRIAL3/run.c] printf warning + From: Robin Barker + Date: Tue, 20 Mar 2001 10:12:04 GMT + Message-Id: <200103201012.KAA04738@tempest.npl.co.uk> + Branch: maint-5.6/perl + ! run.c +____________________________________________________________________________ +[ 9259] By: jhi on 2001/03/20 14:04:39 + Log: Subject: [MacPerl-Porters] [PATCH] POSIX, File::Path (Mac OS) for 5.6.1 and 5.7 + From: Chris Nandor + Date: Tue, 20 Mar 2001 00:40:56 -0500 + Message-Id: + Branch: maint-5.6/perl + ! ext/POSIX/POSIX.xs lib/File/Path.pm +____________________________________________________________________________ +[ 9256] By: jhi on 2001/03/20 04:43:12 + Log: Subject: [PATCH: 5.6.1-trial3] test fixes and installation cleanliness for OS/390 + From: Peter Prymmer + Date: Mon, 19 Mar 2001 16:43:13 -0800 (PST) + Message-ID: + Branch: maint-5.6/perl + ! installperl t/comp/proto.t t/comp/require.t t/op/regmesg.t +____________________________________________________________________________ +[ 9250] By: jhi on 2001/03/19 21:18:00 + Log: A more robust solution for the 64bitall AIX dynaloading + problem, from Jens-Uwe Mager. + Branch: maint-5.6/perl + ! ext/DynaLoader/dl_aix.xs ext/DynaLoader/hints/aix.pl +____________________________________________________________________________ +[ 9247] By: jhi on 2001/03/19 19:59:53 + Log: 64-bit AIX dynaloading problem (see #9244) idea + from Jens-Uwe Mager. + Branch: maint-5.6/perl + ! ext/DynaLoader/dl_aix.xs +____________________________________________________________________________ +[ 9245] By: jhi on 2001/03/19 19:05:19 + Log: Integrate change #9243 from mainline into maintperl. + + Subject: [PATCH perl-5.6.1-TRIAL3/README.vmesa] bad =item paragraphs + Branch: maint-5.6/perl + !> README.vmesa +____________________________________________________________________________ +[ 9244] By: jhi on 2001/03/19 19:03:15 + Log: Get 64bitall AIX building, but still does not test okay: + dynaloading anything fails, for example for op/defins: + Can't load '../lib/auto/File/Glob/Glob.so' for module File::Glob: loadbind: A system call received a parameter that is not valid. at ../lib/XSLoader.pm line 75. at ../lib/File/Glob.pm line 99 + (update: fixed by #9247,9250) + Branch: maint-5.6/perl + ! hints/aix.sh +____________________________________________________________________________ +[ 9241] By: gsar on 2001/03/19 17:34:46 + Log: VMSify tests (from Charles Lane) + Branch: maint-5.6/perl + ! t/lib/filehand.t t/lib/texttabs.t +____________________________________________________________________________ +[ 9239] By: gsar on 2001/03/19 09:23:17 + Log: this is 5.6.1-trial3 + Branch: maint-5.6/perl + ! Changes +____________________________________________________________________________ +[ 9238] By: gsar on 2001/03/19 08:47:04 + Log: some new symbols are only available under ithreads + Branch: maint-5.6/perl + ! makedef.pl +____________________________________________________________________________ +[ 9237] By: gsar on 2001/03/19 08:42:28 + Log: update patchlevel.h, Changes, &c. + Branch: maint-5.6/perl + ! Changes patchlevel.h pod/perlhist.pod + !> AUTHORS +____________________________________________________________________________ +[ 9236] By: gsar on 2001/03/19 08:17:49 + Log: integrate changes#8068,8717 from mainline + + [PATCH 5.7.0@8047] RE: [ID 20001013.009] DB_File issues warning when setting element to undef + + [PATCH CPAN 1.59_51] warning message (not!) + Branch: maint-5.6/perl + !> ext/GDBM_File/GDBM_File.pm ext/GDBM_File/typemap + !> ext/NDBM_File/NDBM_File.pm ext/NDBM_File/typemap + !> ext/ODBM_File/ODBM_File.pm ext/ODBM_File/typemap + !> ext/SDBM_File/SDBM_File.pm ext/SDBM_File/typemap lib/CPAN.pm + !> t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t +____________________________________________________________________________ +[ 9235] By: gsar on 2001/03/19 08:07:09 + Log: integrate changes#8617,8713,8715,8716,8721,8953,8963 from mainline + + [PATCH] Add missing CV flags to dump.c + + Re: [patch] Re: PL_ptr_table + + Fixup non-ithread build after 8713 + + Generated files form 8713 etc. + + Correct the correction :-( + + Documenting coderef @INC (Re: CPAN "make this script work" feature) + + Subject: Re: sync sync sync: have I missed any patches? + Replace djSP with dSP. + Branch: maint-5.6/perl + !> cop.h doio.c doop.c dump.c embed.h embed.pl ext/B/B/C.pm + !> ext/B/B/CC.pm global.sym objXSUB.h perl.c perlapi.c + !> pod/perlhack.pod pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c proto.h + !> sv.c sv.h win32/perlhost.h +____________________________________________________________________________ +[ 9234] By: gsar on 2001/03/19 07:22:05 + Log: revert the change#9090 integrate for now (change looks somewhat + incomplete in that [ha]v_exists() need something similar; lacks + tests; &c.) + Branch: maint-5.6/perl + ! hv.c +____________________________________________________________________________ +[ 9233] By: gsar on 2001/03/19 07:10:01 + Log: some refcounts were incorrect in perl_clone(); avoid hang in global + destruction when there are unreferenced scalars (SvREFCNT==0) + Branch: maint-5.6/perl + ! sv.c +____________________________________________________________________________ +[ 9232] By: jhi on 2001/03/19 05:11:02 + Log: Regen api and toc. + Branch: maint-5.6/perl + ! pod/perlapi.pod pod/perltoc.pod +____________________________________________________________________________ +[ 9231] By: jhi on 2001/03/19 04:06:03 + Log: Integrate changes in #9070,9072,9101 from mainline into maintperl, + add a lost line in pp.c:pp_chop(), update to new op/chop. + + Clarify the description differentiating for and while; inspired by + + Subject: [ID 20010306.004] || != named unary operator + + The $Is_MacOS needs to be declared. + Branch: maint-5.6/perl + ! pp.c t/op/chop.t + !> lib/ExtUtils/Manifest.pm pod/perlop.pod pod/perlsyn.pod +____________________________________________________________________________ +[ 9230] By: jhi on 2001/03/19 03:48:16 + Log: Integrate changes #7971(perlio),8982,9061,9062,9068,9069, + 9079,9083,9089,9090,9091 from mainline to maintperl. + + Quieten some noise in Win32 builds + + Fixes the bugs 20010221.005 and 20010221.008: "the taint checker..." + + The perlretut was still talking about the old \p and \P + definitions. + + More tweakage on the Unicode character class descriptions. + + Subject: Re: [ID 20010305.012] chop() against list assignment returns char chopped from el zero + + Subject: 'no *POSIX' Patch speeding up make on BS2000 + + Subject: [PATCH] perldata.pod here-doc docs + + Add /sbin and /usr/sbin to the list of directories scanned + for setuid programs. Takes care of bug id 20010309.003. + + Subject: Re: [ID 19990808.001] [PATCH] FETCH triggered on exists() + + In op/stat #35 better to scan all the potential directories + for setuids, not just the first one. + Branch: maint-5.6/perl + ! Makefile.SH + !> doio.c hv.c lib/unicode/mktables.PL makedepend.SH perl.h + !> pod/perldata.pod pod/perlretut.pod pp.c t/op/chop.t + !> t/op/stat.t toke.c win32/win32.h +____________________________________________________________________________ +[ 9229] By: jhi on 2001/03/19 02:31:50 + Log: Subject: [MacPerl-Porters] [PATCH] Portability fixes for Mac OS / maint-5.6 + From: Chris Nandor + Date: Sat, 10 Mar 2001 14:22:19 -0500 + Message-Id: + Branch: maint-5.6/perl + ! ext/B/defsubs_h.PL ext/DynaLoader/dl_mac.xs + ! ext/Errno/Errno_pm.PL lib/ExtUtils/Manifest.pm perlsfio.h + ! t/lib/b.t t/lib/errno.t +____________________________________________________________________________ +[ 9228] By: jhi on 2001/03/19 02:29:59 + Log: Integrate changes #9113,9122 from mainline into maintperl. + + Subject: [PATCH: perl@9092, dist-3.0@70] OS/390 mydomain last gasp before silly guess (was Re: What do I need to build EBCDIC perl?) + Branch: maint-5.6/perl + !> Configure README.os390 hints/os390.sh +____________________________________________________________________________ +[ 9227] By: jhi on 2001/03/19 02:22:35 + Log: Integrate #9115,9121,9128,9163,9171,9174,9175 from mainline + into maintperl. + + Subject: Re: [ID 20010305.005] "use integer" doesn't make rand() return integers + + Forgot to check-in the larger part of #9120, duh. + + Subject: Another patch for integer.pm POD + + h2ph strictness and cleanliness from Kurt Starsinic. + + Borland filename case problem. + + h2ph strictness and cleanliness from Kurt Starsinic. + + Subject: [PATCH] the uncontroversial doc patches + Branch: maint-5.6/perl + +> win32/sncfnmcs.pl + !> MANIFEST README.os2 README.win32 ext/GDBM_File/GDBM_File.pm + !> ext/GDBM_File/GDBM_File.xs lib/integer.pm + !> pod/perl5005delta.pod pod/perldebtut.pod pod/perlfunc.pod + !> pod/perlhack.pod pod/perllexwarn.pod pod/perllocale.pod + !> pod/perllol.pod pod/perlmod.pod pod/perlmodlib.pod + !> pod/perlport.pod pod/perlrun.pod pod/perltoc.pod + !> pod/perlxs.pod pod/perlxstut.pod utils/h2ph.PL +____________________________________________________________________________ +[ 9226] By: jhi on 2001/03/19 02:10:21 + Log: Integrate changes #9207,9214 from mainline into maintperl. + + podchecker relaxations: =over has an *optional* number after it, + and whitespace in L<> is okay. + Branch: maint-5.6/perl + !> lib/Pod/Checker.pm lib/Pod/ParseUtils.pm pod/perlpod.pod + !> t/pod/poderrs.xr +____________________________________________________________________________ +[ 9224] By: jhi on 2001/03/19 02:06:11 + Log: Integrate change #9223 from mainline to maintperl. + + Document -Dmksymlinks. + Branch: maint-5.6/perl + !> INSTALL +____________________________________________________________________________ +[ 9222] By: jhi on 2001/03/19 01:15:35 + Log: The -Dmksymlinks wasn't working for maintperl. + Branch: maint-5.6/perl + ! Configure +____________________________________________________________________________ +[ 9219] By: gsar on 2001/03/19 00:16:55 + Log: remove duplicated tests + Branch: maint-5.6/perl + ! t/op/re_tests +____________________________________________________________________________ +[ 9208] By: jhi on 2001/03/18 20:12:12 + Log: Integrate changes #8128,9132 from mainline into maintperl, + Tie::SubstrHash fixes. + Branch: maint-5.6/perl + !> lib/Tie/SubstrHash.pm t/lib/tie-substrhash.t +____________________________________________________________________________ +[ 9197] By: gsar on 2001/03/18 12:15:57 + Log: more thorough cleaning of arenas--keep going until no more + SvREFCNT_dec()s occur (this fixes the problem that causes the + pesky "Scalars leaked" warnings) + Branch: maint-5.6/perl + ! embed.pl perl.c proto.h sv.c t/op/sort.t +____________________________________________________________________________ +[ 9168] By: jhi on 2001/03/15 14:13:22 + Log: Integrate changes #9120,9167 from mainline to maintperl. + + Subject: [PATCH 5.6.1] OS/2 docs + + Subject: [PATCH 5.6.1] perldoc + Branch: maint-5.6/perl + !> os2/Changes utils/perldoc.PL +____________________________________________________________________________ +[ 9162] By: gsar on 2001/03/15 00:56:53 + Log: avoid warnings + Branch: maint-5.6/perl + ! t/op/magic.t +____________________________________________________________________________ +[ 9161] By: gsar on 2001/03/15 00:52:09 + Log: clearing of $ENV{PERL_DESTRUCT_LEVEL} interferes with purify + results + Branch: maint-5.6/perl + ! t/op/magic.t +____________________________________________________________________________ +[ 9154] By: gsar on 2001/03/14 17:48:18 + Log: PerlIO_stdoutf() wasn't properly supported under PERL_IMPLICIT_SYS + (caused Storable 1.0.10 to break on windows) + Branch: maint-5.6/perl + ! embed.h embed.pl global.sym globals.c iperlsys.h objXSUB.h + ! perlapi.c proto.h +____________________________________________________________________________ +[ 9152] By: gsar on 2001/03/14 07:29:40 + Log: back out changes#9012,9010,9009 and parts of change#9016 + (causes ABRs under purify, and some prerequisites don't + seem to be there in 5.6.x) + Branch: maint-5.6/perl + ! doop.c op.c t/op/tr.t toke.c +____________________________________________________________________________ +[ 9142] By: gsar on 2001/03/14 03:20:48 + Log: fix another memory leak reported by purify (tie callbacks that + croak can leak when wiping out magic) + Branch: maint-5.6/perl + ! scope.c +____________________________________________________________________________ +[ 9138] By: gsar on 2001/03/14 01:18:00 + Log: remove squelch controls for "Scalars leaked" messages in most places + (these are now cured) + Branch: maint-5.6/perl + ! t/comp/proto.t t/op/lex_assign.t t/op/local.t t/op/pat.t + ! t/op/regexp.t t/pragma/strict-vars t/pragma/warn/op + ! t/pragma/warn/regcomp t/pragma/warn/toke t/pragma/warnings.t +____________________________________________________________________________ +[ 9137] By: gsar on 2001/03/14 00:57:04 + Log: fix leak in pregcomp() when RE fails to compile (e.g. m/\\/) + Branch: maint-5.6/perl + ! regcomp.c +____________________________________________________________________________ +[ 9133] By: gsar on 2001/03/13 22:46:20 + Log: integrate change#9067 from mainline + + Re: [PATCH: 5.6.1 trial2] DynaLoading for OS/390 build option + Branch: maint-5.6/perl + !> lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 9131] By: gsar on 2001/03/13 22:30:42 + Log: make the error text look more consistent in hints/hpux.sh + Branch: maint-5.6/perl + ! hints/hpux.sh +____________________________________________________________________________ +[ 9116] By: gsar on 2001/03/13 00:55:53 + Log: Win32::GetCwd() returns C: instead of C:\ in the root directory + under ithreads + Branch: maint-5.6/perl + ! win32/perlhost.h +____________________________________________________________________________ +[ 9108] By: gsar on 2001/03/12 10:21:31 + Log: fix memory leak in C arising from a refcount + loop between the outer sub and the inner prototype anonsub + + this also enables closures returned by subroutines that + subsequently get redefined to work without generating coredumps :) + + completely removed the free_closures() hack--it shouldn't be + needed anymore + Branch: maint-5.6/perl + + t/op/anonsub.t + ! MANIFEST embed.h embed.pl op.c op.h pod/perlapi.pod pp_ctl.c + ! proto.h sv.c +____________________________________________________________________________ +[ 9076] By: jhi on 2001/03/07 22:59:39 + Log: Integrate change #7784 from mainline into maintperl. + + Subject: [PATCH 5.7.0] lexicals not recognized in a run-time (?{}) + Branch: maint-5.6/perl + !> pp_ctl.c t/op/pat.t +____________________________________________________________________________ +[ 9064] By: gsar on 2001/03/07 06:29:24 + Log: fix memory leak in pack("Bb",...) + Branch: maint-5.6/perl + ! perl.c +____________________________________________________________________________ +[ 9055] By: jhi on 2001/03/06 02:21:26 + Log: Integrate the change #9054 from mainline: + retract the PMOP cleanup patch pending further investigation. + Branch: maint-5.6/perl + !> op.c op.h +____________________________________________________________________________ +[ 9050] By: jhi on 2001/03/05 21:44:29 + Log: Integrate changes #9033 and #9044 from mainline into maintperl, + Sarathy's fix for ID 20010301.005. + Branch: maint-5.6/perl + !> op.c op.h +____________________________________________________________________________ +[ 9030] By: jhi on 2001/03/05 13:46:49 + Log: Subject: [PATCH 5.6.1] OS/2 cleanup + From: Ilya Zakharevich + Date: Mon, 5 Mar 2001 02:29:44 -0500 + Message-ID: <20010305022944.A10117@math.ohio-state.edu> + Branch: maint-5.6/perl + + os2/os2add.sym + ! MANIFEST lib/ExtUtils/MM_OS2.pm lib/ExtUtils/MM_Unix.pm + ! makedef.pl os2/Changes os2/Makefile.SHs + ! os2/OS2/REXX/Makefile.PL os2/OS2/REXX/REXX.pm + ! os2/OS2/REXX/REXX.xs os2/OS2/REXX/t/rx_cmprt.t os2/os2.c + ! os2/os2.sym os2/os2ish.h +____________________________________________________________________________ +[ 9028] By: gsar on 2001/03/05 09:58:38 + Log: various nits in MM_Unix.pm found by disabling SelfLoader + Branch: maint-5.6/perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 9026] By: jhi on 2001/03/05 02:14:59 + Log: Integrate change #9025 from mainline to maintperl, + retract \N{U+HHHH}. + Branch: maint-5.6/perl + !> lib/charnames.pm pod/perldiag.pod pod/perlretut.pod + !> t/lib/charnames.t toke.c +____________________________________________________________________________ +[ 9019] By: jhi on 2001/03/04 18:18:43 + Log: Integrate changes #9017 and 9018 from mainline into maintperl. + + \N{U+HHHH} fix. + + pattern in G_ARRAY context + Branch: maint-5.6/perl + !> pp_hot.c t/op/pat.t toke.c +____________________________________________________________________________ +[ 9016] By: jhi on 2001/03/04 17:41:22 + Log: Integrate changes #9013,9014,9015 from mainline into maintperl. + + Tweak the get*ent() OS/2 prototypes. + + Add the \N{U+HHHH} syntax. + + More tr/// UTF-8 fixes from Inaba Hiroto. + Branch: maint-5.6/perl + !> doop.c lib/charnames.pm os2/os2.c pod/perldiag.pod + !> pod/perlretut.pod t/lib/charnames.t t/op/tr.t toke.c +____________________________________________________________________________ +[ 9012] By: gsar on 2001/03/04 06:26:14 + Log: avoid warning (nit in change#9009) + Branch: maint-5.6/perl + ! toke.c +____________________________________________________________________________ +[ 9011] By: gsar on 2001/03/04 06:15:24 + Log: lib/charnames.t fails in 5.6.x because of older Unicode + data + + TODO: need to revisit this after updating lib/unicode/... + Branch: maint-5.6/perl + ! t/lib/charnames.t +____________________________________________________________________________ +[ 9010] By: gsar on 2001/03/04 06:08:36 + Log: change#9009 breaks build (no "didrange" variable in 5.6.x) + Branch: maint-5.6/perl + ! toke.c +____________________________________________________________________________ +[ 9009] By: jhi on 2001/03/03 19:27:20 + Log: Integrate change #9008 from mainline to maintperl, + UTF-8 tr/// fixes from Inaba Hiroto. + Branch: maint-5.6/perl + !> doop.c op.c t/op/tr.t toke.c +____________________________________________________________________________ +[ 9006] By: jhi on 2001/03/03 18:58:06 + Log: Subject: [PATCH 5.6.1] More robust Math::Complex + From: Ilya Zakharevich + Date: Sat, 3 Mar 2001 12:51:50 -0500 + Message-ID: <20010303125150.A2147@math.ohio-state.edu> + + Be more robust in our quest for the infinite. + Branch: maint-5.6/perl + ! lib/Math/Complex.pm +____________________________________________________________________________ +[ 9005] By: jhi on 2001/03/03 17:55:50 + Log: The #8982 modified for perl 5.6.x, from Radu Greab. + Branch: maint-5.6/perl + ! doio.c +____________________________________________________________________________ +[ 9003] By: jhi on 2001/03/03 17:15:52 + Log: Integrate change #9002 from mainline to maintperl. + + Subject: [perl-5.6.x, perl-current] accept for EPOC + Branch: maint-5.6/perl + !> pp_sys.c +____________________________________________________________________________ +[ 8999] By: jhi on 2001/03/03 17:09:28 + Log: Subject: [PATCH 5.6.1] syslog.t + From: Ilya Zakharevich + Date: Sat, 3 Mar 2001 02:11:17 -0500 + Message-ID: <20010303021116.A11897@math.ohio-state.edu> + Branch: maint-5.6/perl + ! t/lib/syslog.t +____________________________________________________________________________ +[ 8998] By: jhi on 2001/03/03 17:07:50 + Log: Subject: Re: [PATCH 5.7.0] compiling on OS/2: 5.6.1 too + From: Ilya Zakharevich + Date: Sat, 3 Mar 2001 01:53:52 -0500 + Message-ID: <20010303015352.A11741@math.ohio-state.edu> + Branch: maint-5.6/perl + ! opcode.pl os2/os2.c +____________________________________________________________________________ +[ 8997] By: jhi on 2001/03/03 17:03:30 + Log: Subject: [PATCH 5.6.1] compiling on OS/2 + From: Ilya Zakharevich + Date: Sat, 3 Mar 2001 01:59:59 -0500 + Message-ID: <20010303015959.B11741@math.ohio-state.edu> + Branch: maint-5.6/perl + ! hints/os2.sh +____________________________________________________________________________ +[ 8995] By: jhi on 2001/03/03 00:35:22 + Log: Integrate changes #8099,8218,8220,8221,8227,8304,8317, + 8318,8320,8337,8503,8877,8890,8903,8971 from mainline + to maintperl. + + Subject: Re: [ID 20000328.039] [PATCH] Eliminate Configure use of /tmp + + Add Configure option -Dmksymlinks which will create a symlink + forest if the current/build differs from the source directory. + (8218,8220,8221,8317,8318,8971) + + Subject: Re: A Configure option like 'otherlibdirs' but for *pre*pending? + (Document APPLLIB_EXP in INSTALL.) + + If running byacc write-enable also perly.h. + + DB3 NDBM/ODBM emulation tweaks from Stanislav Brabec . + + Subject: [PATCH 5.7.1/Configure] failure to set src='.' + + Sanity check for conflicting thread flavours. + + Fix the sys/fcntl.h problem reported by Peter Prymmer. + + Add few CPUs/architectures to the Cppsym scan, + add -perlio to archname if so selected (modified 8890) + + Be more helpful for devel builders, suggested by John L. Allen. + (admittedly pointless change for maintperl, but the usedevel + code is there already) + Branch: maint-5.6/perl + !> Configure INSTALL Makefile.SH Porting/Glossary + !> Porting/config.sh Porting/config_H config_h.SH embed.pl + !> epoc/config.sh ext/NDBM_File/NDBM_File.xs + !> ext/ODBM_File/ODBM_File.xs t/io/fs.t warnings.pl + !> win32/config.bc win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 8993] By: jhi on 2001/03/02 23:22:12 + Log: Regenerate various files for maint. + Branch: maint-5.6/perl + ! Porting/Glossary Porting/config.sh Porting/config_H objXSUB.h + ! perlapi.c pod/perlapi.pod pod/perltoc.pod proto.h +____________________________________________________________________________ +[ 8991] By: jhi on 2001/03/02 21:00:08 + Log: Retract the #8742 part of #8986, backward compat. + Branch: maint-5.6/perl + ! embed.pl +____________________________________________________________________________ +[ 8990] By: jhi on 2001/03/02 20:40:07 + Log: Retract the #8919 part of #8987, not applicable to the 5.6 branch. + Branch: maint-5.6/perl + ! hv.c +____________________________________________________________________________ +[ 8987] By: jhi on 2001/03/02 19:43:40 + Log: Integrate changes #8784,8839,8843,8847,8849,8859,8866, + 8873,8874,8876,8879,8901,8902,8908,8913,8918,8919,8946,8947,8948, + 8950,8952,8955 from mainline to maintperl. + + Subject: [PATCH: perl@8773] small fixups to perlclib.pod + + Put to rest the 20010205.001, the email address checking (not) regex. + + fork() not everywhere, cleanup temp files. + + The #8843 wasn't quite right: %Config needs to imported. + + Subject: [PATCH perl@8841] glob-basic.t, runenv.t fix-ups + (#8849: the glob-basic hunk needed massaging as it depended + on Schwern's large-scale (unintegrated) patches) + + Skip the Perl_sys_intern_clear and Perl_sys_intern_init. + + Upgrade to CGI.pm 2.752, from Lincoln Stein. + (Note: there were some conflicts due to EBCDIC and EPOC + patches, in general I preferred the repository code.) + (When 2.753 comes out, we need to synchronize.) + + Subject: [PATCH] fix for charnames above FFFF + + Subject: [patch perl@8841] One URL update and a possible OS Version snag for perlport.pod + + If no sfio, no -lsfio. + + Run run/*.t also in minitest. + + Subject: [PATCH perl 5.7.0] malloc message address offset + + Subject: [PATCH 5.7.0] don't zero CvFLAGS before checking for CvCONST! + + Subject: fix for parameter -Dm (for perl@8867) + + Subject: [PATCH: perl@8892] was Re: hashing order difference? + (make the test more portable) + + Subject: Re: [PATCH] fix for charnames above FFFF + + Subject: Re: I'm losing the war... + (hv_store() not working correctly in ENV_IS_CASELESS case.) + + Subject: Modified README.bs2000 + + Subject: [PATCH: perl@8935] -Dt padsv($var) + + Subject: [PATCH: perl@8890] small fix in pod/perlop.pod + + Subject: PATCH: extra tests to check on negative float to unsigned cast + + Subject: [PATCH] XPUSH[insp] was Re: progress + + Subject: Re: Compile with perlcc.. + Branch: maint-5.6/perl + !> (integrate 36 files) +____________________________________________________________________________ +[ 8986] By: jhi on 2001/03/02 18:51:25 + Log: Integrate changes #8689,8697,8724,8726,8731,8742,8754,8755, + 8763,8767,8770,8772,8795,8796,8813,8822,8823 from mainline + to maintperl. + + Subject: Re: [PATCH lots of pod/] s/chop/chomp/g + + Subject: [DOC PATCH] overload.pm nits + + Add header for LIB$ prototypes (C. Berry) + + Convert fwrite()s to sockets to write()s, since some socket stacks + don't take kindly to stdio. + Ignore "expected" SS$_NOLOGNAM when doing internal LNM lookups + (for often optional LNMs) + Correct a few typos + (C. Bailey) + + Subject: [PATCH: 5.6.1 trial2 && perl@8671] provide EBCDIC CGI::Util::escape() and test + + De-cut-and-pasto. + + Subject: Re: [PATCH embed.pl] Forgot to add ./lib to @INC for File::Glob + + Upgrade to Text-Tabs+Wrap-2001.0131 from David Muir Sharnoff. + + Upgrade to CPAN 1.59_54, from Andreas König. + + Bogus shebang. + + Subject: [PATCH] Document makepatch in Porting/patching + + UTF-8 documentation. + + Subject: Re: [PATCH] pod/perlclib.pod - Replacements for C library functions + + Sort the MANIFEST. + + Subject: [ID 20010210.002] perldiag doesn't include the "Scalars leaked" message + + Subject: [PATCH @8807] toke.c cleanup: scan_str() + + Subject: [PATCH perl.c] Fixing PERL5OPT (was Re: Warnings, strict, and CPAN) + + Add run/*.t to testables. + + TODO: integrate #8784. + Branch: maint-5.6/perl + +> pod/perlclib.pod t/lib/cgi-esc.t t/run/runenv.t + !> (integrate 28 files) +____________________________________________________________________________ +[ 8984] By: jhi on 2001/03/02 16:00:17 + Log: Integrate changes #8978,8979,8980,8981,8983 from mainline. + + perlfaq1 reworded to suggest 5.6.0 or 5.005_03, or POSSIBLY + 5.004_05, and mention the suidperl August 2000 security problem. + (#8978,#8981) + + Subject: [ID 20010301.004] Technically speaking in perldata + + Subject: [PATCH] File::Copy for bleadperl, maintperl + + Subject: [PATCH 5.7.0/5.6.0+] VMS piping ... cleanup at interpreter exit + + (The #8982, fix for 20010221.005 and 20010221.008, + would be nice too but it didn't integrate cleanly.) + Branch: maint-5.6/perl + !> lib/File/Copy.pm pod/perldata.pod pod/perlfaq1.pod vms/vms.c +____________________________________________________________________________ +[ 8974] By: gsar on 2001/03/01 16:28:21 + Log: fix for bugid 20010226.008 + + the problem was that some of the pointers (PL_last_lop and + PL_last_uni specifically) into the lex buffers weren't correctly + being invalidated when the buffer changed; this would leave the + pointers pointing at an arbitrary location in the buffer if + the buffer didn't need to be reallocated, or point into freed + memory if the buffer had to be realloced + + TODO item for bugdb maintainers: check other seemingly random + parser-related bugs--they might be cured by this + Branch: maint-5.6/perl + ! toke.c +____________________________________________________________________________ +[ 8960] By: jhi on 2001/02/27 22:51:33 + Log: Subject: [PATCH perl@8958 and 5.6.1-trial2] configure.com bug fixing spree + From: "Craig A. Berry" + Date: Tue, 27 Feb 2001 16:11:44 -0600 + Message-Id: <5.0.2.1.0.20010227150548.02a200f8@exchi01> + Branch: maint-5.6/perl + ! configure.com vms/descrip_mms.template +____________________________________________________________________________ +[ 8957] By: jhi on 2001/02/27 06:15:07 + Log: Subject: [5.6.x] EPOC additions + From: Olaf Flebbe + Date: Mon, 26 Feb 2001 23:33:46 +0100 (CET) + Message-ID: + Branch: maint-5.6/perl + ! AUTHORS README.epoc epoc/createpkg.pl pp_sys.c +____________________________________________________________________________ +[ 8945] By: jhi on 2001/02/26 14:19:53 + Log: Integrate the t/op/sprintf.t parts of #7909 and #8944 from mainline + to maintperl, listing the known failures on the tests 129 and 130. + Branch: maint-5.6/perl + !> t/op/sprintf.t +____________________________________________________________________________ +[ 8917] By: jhi on 2001/02/23 20:27:51 + Log: Integrate change #8916 from mainline, + do away with USE_WIN32_RTL_ENV. + Branch: maint-5.6/perl + !> perl.c util.c win32/win32.c win32/win32.h win32/win32iop.h +____________________________________________________________________________ +[ 8911] By: jhi on 2001/02/23 04:20:02 + Log: Integrate changes #8896,8897,8898,8906,8907,8908 from mainline. + + Duplicated environment freeing, File::Temp 0.12, + op/append portability (EBCDIC) tweak. + Branch: maint-5.6/perl + !> lib/File/Temp.pm perl.c t/lib/ftmp-mktemp.t t/lib/ftmp-posix.t + !> t/op/append.t +____________________________________________________________________________ +[ 8910] By: jhi on 2001/02/23 02:07:33 + Log: Integrate change #8909 from mainline, a better Borland + putenv() workaround. + Branch: maint-5.6/perl + !> perl.c +____________________________________________________________________________ +[ 8900] By: jhi on 2001/02/23 01:18:02 + Log: Integrate changes #8898,8899 from mainline, environ handling. + Branch: maint-5.6/perl + !> perl.c +____________________________________________________________________________ +[ 8894] By: gsar on 2001/02/22 19:06:18 + Log: integrate changes#6162,6163 from mainline (missing leak fixes!) + + fix memory leak in method call optimization (change#3768); + made Cfoo()"> leak + + fix memory leak in C (bug in change#4579) + Branch: maint-5.6/perl + !> op.c +____________________________________________________________________________ +[ 8886] By: jhi on 2001/02/22 12:49:24 + Log: Integrate changes #8883,8884 from mainline to maintperl. + + Subject: [patch: perl@8867] embed.{h|pl} need not mention ebcdic_control ... + Subject: Re: File::Temp::_gettemp warning + Branch: maint-5.6/perl + !> embed.h embed.pl lib/File/Temp.pm +____________________________________________________________________________ +[ 8885] By: jhi on 2001/02/22 12:43:59 + Log: Based on + + Subject: [ID 20010222.001] POSIX.xs IV vs NV bug + From: schwab@suse.de + Date: Thu, 22 Feb 2001 13:08:09 +0100 + Message-Id: <200102221208.f1MC89H09364@sykes.suse.de> + + but the fix done slightly differently because the other + half was already done in #8664. + Branch: maint-5.6/perl + ! ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 8882] By: jhi on 2001/02/21 19:41:33 + Log: Integrate change #8881 from mainlin to maintperl. + + Subject: [PATCH - perl8585] glob-in-eval memory leak fix + Branch: maint-5.6/perl + !> op.c +____________________________________________________________________________ +[ 8871] By: jhi on 2001/02/21 14:07:29 + Log: Integrate change #8868 from pureperl to maintperl. + + Fixed reference count loop caused by sv_magic. + Branch: maint-5.6/perl + !> sv.c +____________________________________________________________________________ +[ 8863] By: jhi on 2001/02/20 20:55:11 + Log: Integrate change #8860,8861 from mainline into maintperl. + + "pseudo-literal j" + + Subject: [PATCH: 5.6.1 trial2 && perl@8807] workaround VMS I/O problem in Test.pm for bug ID 20010213.009 + Branch: maint-5.6/perl + !> lib/Test.pm pod/perlop.pod +____________________________________________________________________________ +[ 8856] By: jhi on 2001/02/20 17:33:16 + Log: Integrate change #8848 from mainline to maintperl: ?DBM_File cleanup. + Branch: maint-5.6/perl + !> ext/GDBM_File/GDBM_File.pm ext/NDBM_File/NDBM_File.pm + !> ext/ODBM_File/ODBM_File.pm ext/SDBM_File/SDBM_File.pm + !> t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t +____________________________________________________________________________ +[ 8855] By: jhi on 2001/02/20 17:32:13 + Log: Integrate pureperl changes #8844,8845,8850 to maintperl. + + Fixed %^H scoping bug + + Removed GV <-> CV refcount loop + + Removed %ENV refcount loop + Branch: maint-5.6/perl + !> gv.c op.c perl.c pp.c scope.c +____________________________________________________________________________ +[ 8854] By: jhi on 2001/02/20 17:25:06 + Log: Subject: Addition to readme.win32 for Borland C++ compilers + Date: Tue, 20 Feb 2001 02:15:25 +0300 + From: "Vadim Konovalov" + Message-ID: <011c01c09aca$93bbbec0$367b55c2@vad> + + Document Borland compiler misbehaviour. + Branch: maint-5.6/perl + ! README.win32 +____________________________________________________________________________ +[ 8853] By: jhi on 2001/02/20 17:22:25 + Log: The assimilation of ebcdic.c didn't quite work at the first try, + patches from Thomas Dorner. + Branch: maint-5.6/perl + ! handy.h util.c +____________________________________________________________________________ +[ 8852] By: jhi on 2001/02/20 17:20:15 + Log: Subject: [PATCH] More Mac OS patches for maint-5.6 + From: Chris Nandor + Date: Tue, 20 Feb 2001 08:32:45 -0500 + Message-Id: + Branch: maint-5.6/perl + ! makedef.pl mg.c +____________________________________________________________________________ +[ 8831] By: jhi on 2001/02/18 19:14:20 + Log: Integrate change #8827 from mainline. + + UTF8 tweaks. + Branch: maint-5.6/perl + !> sv.c utf8.c +____________________________________________________________________________ +[ 8818] By: jhi on 2001/02/18 02:24:50 + Log: FAQ nit from Chris Fedde. + Branch: maint-5.6/perl + ! pod/perlfaq4.pod +____________________________________________________________________________ +[ 8810] By: jhi on 2001/02/15 13:35:08 + Log: Upgrade to podlators 1.08, from Russ Allbery. + Branch: maint-5.6/perl + ! lib/Pod/Man.pm lib/Pod/Text.pm +____________________________________________________________________________ +[ 8809] By: jhi on 2001/02/15 13:26:38 + Log: (accidentally empty check-in) + Branch: maint-5.6/perl + ! lib/Test/Harness.pm +____________________________________________________________________________ +[ 8808] By: jhi on 2001/02/15 13:23:47 + Log: Subject: [PATCH 5.6.1-TRIAL2] perldoc.PL using install directories + From: Russ Allbery + Date: 14 Feb 2001 10:15:41 -0800 + Message-ID: + + perldoc was hardcoding $Config{installscript}, which breaks + when install* isn't where Perl ends up (such as with AFS). + + Use $Config{scriptdir} instead. + Branch: maint-5.6/perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 8806] By: jhi on 2001/02/14 14:25:31 + Log: Integrate changes #8803,8804,8805 from mainline. + + Duplicate environment for JPL so that JDK 1.2/1.3 don't get upset. + + Don't skip too much of the locale error message if no environ array, + from Chris Nandor. + + More MacOS Classic fixes from Chris Nandor. + Branch: maint-5.6/perl + !> doop.c lib/Cwd.pm perl.c perl.h util.c +____________________________________________________________________________ +[ 8801] By: jhi on 2001/02/13 17:55:19 + Log: Integrate change #8792 from mainline. + + Subject: buncha MacPerl patches for bleadperl + From: Chris Nandor + Date: Tue, 13 Feb 2001 00:02:43 -0500 + Message-Id: + Branch: maint-5.6/perl + !> lib/AutoLoader.pm lib/AutoSplit.pm lib/ExtUtils/MakeMaker.pm + !> lib/File/Basename.pm makedef.pl perl.c pp_ctl.c + !> t/lib/basename.t toke.c util.h +____________________________________________________________________________ +[ 8800] By: jhi on 2001/02/13 17:46:43 + Log: When doing that Fpos_t used in PerlIO_getpos proto needs + to be forced to Off_t. + + Subject: [ID 20010201.009] 5.6.1-TRIAL2 sfio build fails + From: nick@ccl4.org + Date: Thu, 1 Feb 2001 12:01:04 +0000 + Message-Id: <20010201120103.E11401@plum.flirble.org> + Branch: maint-5.6/perl + ! iperlsys.h perlio.c +____________________________________________________________________________ +[ 8799] By: jhi on 2001/02/13 16:52:51 + Log: Duplex duplex hunk hunk. + Branch: maint-5.6/perl + ! Makefile.SH +____________________________________________________________________________ +[ 8794] By: jhi on 2001/02/13 14:26:51 + Log: Integrate change #8793 from mainline, FAQ updates. + Branch: maint-5.6/perl + !> pod/perlfaq5.pod pod/perlfaq6.pod pod/perlfaq9.pod +____________________________________________________________________________ +[ 8791] By: jhi on 2001/02/13 14:10:39 + Log: Integrate change #8790 from mainline. + + environ array wrongly assumed in Perl_init_i18nl10n(), + Branch: maint-5.6/perl + !> util.c +____________________________________________________________________________ +[ 8789] By: jhi on 2001/02/13 13:58:07 + Log: Integrate changes #8373,8487,8544,8783 from mainline. + + Synchronize the EBCDIC platforms (os390,posix-bc,vmesa): + hints files, the dynaloading, assimilate ebcdic into util.c. + Branch: maint-5.6/perl + - ebcdic.c + ! MANIFEST hints/posix-bc.sh + !> Makefile.SH embed.h embed.pl ext/DynaLoader/dl_dllload.xs + !> handy.h hints/os390.sh hints/vmesa.sh installperl objXSUB.h + !> perlapi.c proto.h util.c +____________________________________________________________________________ +[ 8786] By: jhi on 2001/02/13 05:54:34 + Log: Subject: perl@8671 on posix-bc aka BS2000 Posix (small Patch included!) + From: Dorner Thomas + Date: Mon, 12 Feb 2001 15:06:26 +0100 + Message-ID: <6727B1DACFCDD311A757009027CA8D69010A8853@Ex02.inhouse.start.de> + Branch: maint-5.6/perl + ! Makefile.SH +____________________________________________________________________________ +[ 8782] By: jhi on 2001/02/13 02:00:07 + Log: Add OpenBSD to the list of 5.6.1-okay platforms. + Branch: maint-5.6/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 8781] By: jhi on 2001/02/13 01:58:44 + Log: OpenBSD hints update for 5.6.1-TRIAL2 from Todd C. Miller. + Branch: maint-5.6/perl + ! hints/openbsd.sh +____________________________________________________________________________ +[ 8780] By: jhi on 2001/02/13 01:57:33 + Log: Synchronize the regexp tests between maintperl and mainline. + Branch: maint-5.6/perl + !> t/op/re_tests +____________________________________________________________________________ +[ 8777] By: jhi on 2001/02/13 00:17:54 + Log: Subject: Re: [ID 20010212.006] Core dump with /((?:hard|soft)cover)?/ + From: Hugo + Date: Tue, 13 Feb 2001 00:11:11 +0000 + Message-Id: <200102130011.AAA14310@crypt.compulink.co.uk> + Branch: maint-5.6/perl + ! regcomp.c t/op/re_tests +____________________________________________________________________________ +[ 8776] By: jhi on 2001/02/12 23:25:52 + Log: Add VOS to the list of 5.6.1 known-to-be-working platforms. + Branch: maint-5.6/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 8775] By: jhi on 2001/02/12 23:04:28 + Log: VOS updates for 5.6-TRIAL2 from Paul Green. + Branch: maint-5.6/perl + ! README.vos vos/Changes vos/build.cm vos/config.alpha.def + ! vos/config.alpha.h vos/config.ga.def vos/config.ga.h + ! vos/configure_perl.cm +____________________________________________________________________________ +[ 8758] By: jhi on 2001/02/10 18:01:17 + Log: Integrate changes #8701,8704,8756 from pureperl to maintperl. + + Fixed UMRs and leak in Perl_pmtrans() + + Several leaks an UMRs fixed, mainly in the area of Perl_pmtrans and + associated UTFied tr/// code. Also fixed scoping leak of + PL_reg_start_tmp. + + newATTRSUB leaks when an attempt to redefine the active sort sub is + made. + Branch: maint-5.6/perl + !> op.c regcomp.c +____________________________________________________________________________ +[ 8748] By: jhi on 2001/02/09 18:31:34 + Log: Integrate changes #8673,8674,8676 from maintperl into mainline, + plus manual tweakage. + + Sync the perlfaq2 between mainline and maintperl. + Branch: maint-5.6/perl + ! pod/perlfaq2.pod + Branch: perl + !> pod/perlfaq2.pod +____________________________________________________________________________ +[ 8746] By: jhi on 2001/02/09 18:03:43 + Log: Integrate changes #8699,8708,8709,8744,8745 from mainline. + + Subject: perlfaq2, re: perlmongers + + Subject: Re: [PATCH pod/[bt]ootc?.pod] Adding mention of useful CPAN modules + + Subject: [PATCH pod/perlmodlib.PL 5.6.1-TRIAL2] Up to date CPAN mirror list + + Subject: [ID 20010205.001] typo in perlfaq9 + + Subject: [ID 20010208.002] unordered explanation in perlcall + Branch: maint-5.6/perl + !> pod/perlapi.pod pod/perlboot.pod pod/perlcall.pod + !> pod/perlfaq2.pod pod/perlfaq9.pod pod/perlmodlib.PL + !> pod/perlobj.pod pod/perltoot.pod pod/perltootc.pod +____________________________________________________________________________ +[ 8740] By: jhi on 2001/02/09 17:03:46 + Log: Subject: [PATCH perl-current] perlfaq3.pod, URL for vile + From: "Brendan O'Dea" + Date: Sun, 4 Feb 2001 11:17:56 +1100 + Message-ID: <20010204111756.A16301@compusol.com.au> + Branch: maint-5.6/perl + ! pod/perlfaq3.pod +____________________________________________________________________________ +[ 8739] By: jhi on 2001/02/09 17:01:59 + Log: Subject: [PATCH: perl-5.6.1-TRIAL2] installhtml change to build prettier html files + From: "Indy Singh" + Date: Fri, 2 Feb 2001 15:09:59 -0500 + Message-ID: <02b601c08d54$23fd3560$d24b7018@cr637287a> + + Html files will be generated with a header to make them look + a little less bare. + Branch: maint-5.6/perl + ! installhtml +____________________________________________________________________________ +[ 8738] By: jhi on 2001/02/09 16:58:48 + Log: Subject: [PATCH: perl-5.6.1-TRIAL2] Win32 Makefile change to move html directory + From: "Indy Singh" + Date: Fri, 2 Feb 2001 15:08:23 -0500 + Message-ID: <02b501c08d53$ec354550$d24b7018@cr637287a> + + Html files will be installed in a more logical and easier to + find directory. E.g. c:\perl\html instead of c:\perl\lib\pod\html + Branch: maint-5.6/perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 8736] By: jhi on 2001/02/09 16:42:31 + Log: Latin nit from Philip Newton. + Branch: maint-5.6/perl + ! README.hpux +____________________________________________________________________________ +[ 8733] By: jhi on 2001/02/09 15:35:47 + Log: Subject: Re: [PATCH: 5.6.1 trial 2 && perl@8671] some coded char set issues in perlre.pod + From: Prymmer/Kahn + Date: Thu, 8 Feb 2001 21:21:22 -0800 (PST) + Message-ID: + Branch: maint-5.6/perl + ! pod/perlre.pod +____________________________________________________________________________ +[ 8732] By: jhi on 2001/02/09 15:26:17 + Log: Rename README.posix-bc to README.bs2000 (to avoid the + confusion of a "perlposix-bc.pod"), add a few missing + arch pods, regen toc. + Branch: maint-5.6/perl + +> README.bs2000 + - README.posix-bc + ! MANIFEST pod/buildtoc.PL pod/perl.pod pod/perlport.pod + ! pod/perltoc.pod win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 8728] By: jhi on 2001/02/09 14:46:06 + Log: Subject: [PATCH: 5.6.1 trial 2 && perl@8671] podify README.vmesa + From: Peter Prymmer + Date: Thu, 8 Feb 2001 13:00:30 -0800 (PST) + Message-ID: + Branch: maint-5.6/perl + ! README.vmesa win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 8727] By: jhi on 2001/02/09 14:33:25 + Log: Integrate change #8712 from mainline. + + [PATCH: perl-5.6.1 trial2 && perl@8671] VMS specific simplification for Pod::Find + Branch: maint-5.6/perl + !> lib/Pod/Find.pm +____________________________________________________________________________ +[ 8725] By: jhi on 2001/02/09 04:56:47 + Log: Add NonStopUX to the list of 5.6.1-proven platforms. + Branch: maint-5.6/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 8723] By: jhi on 2001/02/09 03:29:29 + Log: Integrate change #8722 from mainline. + + The Im() function wasn't returning zero for non-Math::Complex + arguments. The bug reported by John Gamble. + Branch: maint-5.6/perl + !> lib/Math/Complex.pm +____________________________________________________________________________ +[ 8703] By: gsar on 2001/02/06 02:29:37 + Log: $(MAKE) distclean doesn't clean up properly on windows + Branch: maint-5.6/perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 8702] By: gsar on 2001/02/06 01:00:46 + Log: tweak change#8659 to keep it simple + Branch: maint-5.6/perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 8701] By: gsar on 2001/02/05 22:45:41 + Log: change#8693 was missing testsuite changes + Branch: maint-5.6/perl + !> t/lib/db-btree.t t/lib/db-hash.t t/lib/db-recno.t +____________________________________________________________________________ +[ 8695] By: gsar on 2001/02/05 03:27:34 + Log: thread.h tweak to enable 5005threads on HP-UX 10.20 with DCE threads + Branch: maint-5.6/perl + ! thread.h +____________________________________________________________________________ +[ 8693] By: gsar on 2001/02/04 22:38:49 + Log: integrate changes#7801,8068,8094,8108,8196 from mainline (DB_File + changes) + Branch: maint-5.6/perl + !> ext/DB_File/Changes ext/DB_File/DB_File.pm + !> ext/DB_File/DB_File.xs ext/DB_File/dbinfo ext/DB_File/typemap + !> ext/DB_File/version.c +____________________________________________________________________________ +[ 8687] By: jhi on 2001/02/03 17:11:42 + Log: HP-UX thread patches from Merijn H. Brand. + Branch: maint-5.6/perl + ! README.hpux hints/hpux.sh +____________________________________________________________________________ +[ 8682] By: jhi on 2001/02/03 05:52:11 + Log: IRIX hints fix from Scott Henry, get Configure -Dcc="cc -64 -mips3" + to work correctly. + Branch: maint-5.6/perl + ! hints/irix_6.sh +____________________________________________________________________________ +[ 8681] By: jhi on 2001/02/03 05:47:33 + Log: perlport tweaks from Peter Prymmer and Chris Nandor. + Branch: maint-5.6/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 8680] By: jhi on 2001/02/02 21:39:49 + Log: perlport update from Peter Prymmer. + Branch: maint-5.6/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 8678] By: gsar on 2001/02/02 16:02:12 + Log: note about bincompat, slightly modified (from Lupe Christoph) + Branch: maint-5.6/perl + ! README.solaris +____________________________________________________________________________ +[ 8677] By: jhi on 2001/02/02 15:46:20 + Log: Supported platforms updates. + Branch: maint-5.6/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 8676] By: jhi on 2001/02/02 03:41:26 + Log: A couple more perlfaq2 tweaks. + Branch: maint-5.6/perl + ! pod/perlfaq2.pod +____________________________________________________________________________ +[ 8675] By: jhi on 2001/02/02 03:17:44 + Log: Misedit in #8661. + Branch: maint-5.6/perl + ! Configure +____________________________________________________________________________ +[ 8674] By: jhi on 2001/02/02 03:14:38 + Log: Damien again. + Branch: maint-5.6/perl + ! pod/perlfaq2.pod +____________________________________________________________________________ +[ 8673] By: jhi on 2001/02/02 03:12:40 + Log: perlfaq update from Elaine Ashton. + Branch: maint-5.6/perl + ! pod/perlfaq2.pod +____________________________________________________________________________ +[ 8672] By: jhi on 2001/02/02 03:07:08 + Log: UTF-8 s/// patch from Inaba Hiroto. + Branch: maint-5.6/perl + ! pp_ctl.c pp_hot.c +____________________________________________________________________________ +[ 8669] By: jhi on 2001/02/01 21:57:02 + Log: Subject: Re: [PATCH perl5.6.1-TRIAL2] long C<=item>s in perlmodlib.pod + From: Robin Barker + Date: Thu, 1 Feb 2001 16:59:05 GMT + Message-Id: <200102011659.QAA01274@tempest.npl.co.uk> + Branch: maint-5.6/perl + ! pod/perlmodlib.PL +____________________________________________________________________________ +[ 8667] By: gsar on 2001/02/01 16:59:11 + Log: add ppaddr as one of the compatibility symbols under -DPERL_POLLUTE + Branch: maint-5.6/perl + ! embed.pl embedvar.h +____________________________________________________________________________ +[ 8666] By: gsar on 2001/02/01 16:34:51 + Log: add missing entries to win32/config.?c + Branch: maint-5.6/perl + ! win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc +____________________________________________________________________________ +[ 8665] By: jhi on 2001/02/01 14:58:51 + Log: Subject: Re: [ID 20010201.006] bad pointer from perlfunc to perlmod + From: "Stephen P. Potter" + Date: Thu, 01 Feb 2001 10:45:46 -0500 + Message-Id: <200102011545.KAA31479@spotter.yi.org> + Branch: maint-5.6/perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 8664] By: gsar on 2001/02/01 14:52:37 + Log: need to use INT2PTR instead of a straight cast or ia64 fails + posix.t (from Brendan O'Dea ) + Branch: maint-5.6/perl + ! ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 8663] By: jhi on 2001/02/01 14:09:13 + Log: Allow the float to be fuzzier. + Branch: maint-5.6/perl + ! t/lib/peek.t +____________________________________________________________________________ +[ 8662] By: jhi on 2001/02/01 13:59:00 + Log: Subject: [PATCH perl5.6.1-TRIAL2] long C<=item>s in perlmodlib.pod + From: Robin Barker + Date: Thu, 1 Feb 2001 13:05:39 GMT + Message-Id: <200102011305.NAA26160@tempest.npl.co.uk> + Branch: maint-5.6/perl + ! pod/perlmodlib.pod +____________________________________________________________________________ +[ 8661] By: jhi on 2001/02/01 13:57:38 + Log: Subject: [PATCH] Re: v5.6.1 trial2 is available + Date: Thu, 01 Feb 2001 14:15:41 +0100 + From: "H.Merijn Brand" + Message-Id: <20010201141104.303F.H.M.BRAND@hccnet.nl> + + Have the $ccflags in the gcc version test (strange, this change + is claimed to be have been integrated already) + Branch: maint-5.6/perl + ! Configure +____________________________________________________________________________ +[ 8660] By: jhi on 2001/02/01 13:44:10 + Log: Integrate changes #7950,7964,7962 from mainline. + + Find the stdchar signedness using cpp, should fix some of + the Solaris compiler warnings reported by Alan Burlison. + Branch: maint-5.6/perl + !> Configure config_h.SH +____________________________________________________________________________ +[ 8659] By: jhi on 2001/02/01 05:35:32 + Log: Subject: [PATCH 5.6.1-TRIAL? and 5.7.?] perldoc uses unescaped backslashes in filenames + From: Jan Dubois + Date: Wed, 31 Jan 2001 21:17:03 -0800 + Message-ID: <8qrh7t069jt32m98sap53l9dfoge0vjrle@4ax.com> + Branch: maint-5.6/perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 8658] By: jhi on 2001/02/01 04:33:17 + Log: Integrate the README.os390 and README.posix-bc parts of mainline + changes #8373,8486, 8544,8556. (The hints/os390.sh,Makefile.SH, + installperl parts were taken care of by #8657.) + Branch: maint-5.6/perl + !> README.os390 README.posix-bc +____________________________________________________________________________ +[ 8657] By: jhi on 2001/02/01 04:29:21 + Log: Subject: [PATCH: 5.6.1 trial2] DynaLoading for OS/390 build option + From: Peter Prymmer + Date: Wed, 31 Jan 2001 18:18:11 -0800 (PST) + Message-ID: + Branch: maint-5.6/perl + + ext/DynaLoader/dl_dllload.xs + ! MANIFEST Makefile.SH hints/os390.sh installperl +____________________________________________________________________________ +[ 8656] By: jhi on 2001/02/01 04:25:45 + Log: Subject: [PATCH: 5.6.1 trial2]Not OK: perl v5.6.1 +v5.6.1-TRIAL2 on os390 05.00 (UNINSTALLED) + From: Peter Prymmer + Date: Wed, 31 Jan 2001 15:26:57 -0800 (PST) + Message-ID: + Branch: maint-5.6/perl + ! lib/Math/BigInt.pm lib/bigint.pl t/lib/b.t t/pragma/sub_lval.t +____________________________________________________________________________ +[ 8655] By: jhi on 2001/02/01 04:14:47 + Log: Subject: [ID 20010131.066] Not OK: perl v5.6.1 +v5.6.1-TRIAL2 on os2 2.40 (UNINSTALLED) + From: troc@netrus.net + Date: Wed, 31 Jan 2001 22:31:26 -0500 + Message-Id: <200102010331.WAA117.85@rocco.homenet> + Branch: maint-5.6/perl + ! os2/os2.c +____________________________________________________________________________ +[ 8654] By: jhi on 2001/02/01 04:12:52 + Log: Solaris 2.7 i386 #defines SP in /usr/include/sys/reg.h + as reported by Alan Burlison. + Branch: maint-5.6/perl + ! pp.h +____________________________________________________________________________ +[ 8653] By: jhi on 2001/02/01 04:05:12 + Log: Subject: [ID 20010131.042] Not OK: perl v5.6.1 +v5.6.1-TRIAL2 on VMS_AXP V7.2-1 + From: dsugalski@northernlight.com + Date: Wed, 31 Jan 2001 18:54:11 -0500 + Message-Id: <01013118541126@monsoon.stratus.northernlight.com> + Branch: maint-5.6/perl + ! configure.com +____________________________________________________________________________ +[ 8652] By: jhi on 2001/02/01 04:03:11 + Log: Misplaced #endif. + + Subject: [perl-5-6-1-trial2] patches for EPOC + From: Olaf Flebbe + Date: Wed, 31 Jan 2001 23:15:34 +0100 (CET) + Message-ID: + Branch: maint-5.6/perl + ! epoc/epocish.c +____________________________________________________________________________ +[ 8651] By: jhi on 2001/02/01 04:00:25 + Log: Integrate changes #8647,8648,8650 from mainline. + + Macrofy a magic UTF-8 test. + + Protect PL_numeric_radix_sv with USE_NUMERIC_LOCALE. + + Watch out for cross compiling for EPOC (usually done on linux). + Branch: maint-5.6/perl + !> ext/Errno/Errno_pm.PL sv.c utf8.c utf8.h +____________________________________________________________________________ +[ 8649] By: gsar on 2001/02/01 00:46:00 + Log: perl_clone() wants to clone PL_numeric_radix_sv (fix for change#8626) + Branch: maint-5.6/perl + ! sv.c +____________________________________________________________________________ +[ 8646] By: gsar on 2001/01/31 15:55:12 + Log: update Changes + Branch: maint-5.6/perl + ! Changes +____________________________________________________________________________ +[ 8645] By: gsar on 2001/01/31 15:10:14 + Log: Configure tweak suggested by Peter Prymmer + Branch: maint-5.6/perl + ! Configure +____________________________________________________________________________ +[ 8644] By: gsar on 2001/01/31 15:06:32 + Log: more files need to be writable in the source distribution + Branch: maint-5.6/perl + ! Porting/makerel +____________________________________________________________________________ +[ 8643] By: jhi on 2001/01/31 14:59:46 + Log: Integrate changes #8258,8278,8279 from mainline. + + Make the large file tests more robust/talkative. + Branch: maint-5.6/perl + !> t/lib/syslfs.t t/op/lfs.t +____________________________________________________________________________ +[ 8642] By: gsar on 2001/01/31 14:53:48 + Log: integrate changes#8311,8334 from mainline + + Add a new MakeMaker variable PM_FILTER that defines a Unix + filter to be run on each .pm during the pm_to_blib() phase, + a fixed version of + Subject: PATCH (blead 8269) ExtUtils::MakeMaker + + Subject: PATCH 5.6.1 & blead 8327 -- workaround for t/io/fs.t + Apparently, the glibc2.2 + linux 2.4.0 + NFS combination prevent + accurate reading of the "atime". + Branch: maint-5.6/perl + !> lib/ExtUtils/Install.pm lib/ExtUtils/MM_Unix.pm + !> lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MM_Win32.pm + !> lib/ExtUtils/MakeMaker.pm t/io/fs.t +____________________________________________________________________________ +[ 8641] By: jhi on 2001/01/31 14:46:37 + Log: Upgrade to Getopt::Long 2.25, from Johan Vromans. + Branch: maint-5.6/perl + ! lib/Getopt/Long.pm +____________________________________________________________________________ +[ 8640] By: gsar on 2001/01/31 14:40:24 + Log: make regen_all + Branch: maint-5.6/perl + ! patchlevel.h pod/perlmodlib.pod pod/perltoc.pod +____________________________________________________________________________ +[ 8639] By: gsar on 2001/01/31 14:37:25 + Log: refresh windows config files + Branch: maint-5.6/perl + ! win32/Makefile win32/config_H.bc win32/config_H.gc + ! win32/config_H.vc win32/makefile.mk +____________________________________________________________________________ +[ 8638] By: gsar on 2001/01/31 14:28:10 + Log: makefile tweaks for windows: introduce a bulk-switch to enable + same options as ActivePerl; sync changes with makefile.mk + Branch: maint-5.6/perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 8636] By: jhi on 2001/01/31 02:38:32 + Log: Integrate changes #7884,8122,8155,8197,8213[just to /nolog part, + no perlio],8257,8380,8479,8515 from mainline. + + Subject: [PATCH perl@7795 (and earlier)] VMS test cleanup + + Subject: Re: [ID 20001214.011] Unreachable value in a search list logical name + Subject: [PATCH perl@8133] fix-up for VMS extensions + + In VMS embedded perls couldn't access the statically built Socket. + + Subject: [patch: perl@8211]VMS: add -Duseperlio capacity to configure.com (8213) + + Further VMS piping fixes from Charles Lane. + + Subject: [PATCH] make t/op/misc.t work on VMS + + Add tracing for debugging extensions builds in VMS. + + Subject: [PATCH perl@8506] typo in last week's configure.com frenzy + Branch: maint-5.6/perl + !> configure.com doio.c t/op/misc.t vms/descrip_mms.template + !> vms/ext/DCLsym/Makefile.PL vms/ext/Stdio/Makefile.PL + !> vms/test.com vms/vms.c vms/vmsish.h vms/vmspipe.com +____________________________________________________________________________ +[ 8635] By: jhi on 2001/01/31 01:46:41 + Log: Integrate change #7732 from mainline. + + Sparc 64-bit pack() fix from Jens Hamisch. + Branch: maint-5.6/perl + !> pp.c +____________________________________________________________________________ +[ 8634] By: jhi on 2001/01/31 01:41:16 + Log: One spot missing from #8626. + Branch: maint-5.6/perl + ! sv.c +____________________________________________________________________________ +[ 8633] By: jhi on 2001/01/31 00:49:17 + Log: Integrate change #7495 from mainline. + + Subject: [PATCH: perl@7483] generalize AIX ccversion hack for re extension + Branch: maint-5.6/perl + !> MANIFEST ext/re/Makefile.PL +____________________________________________________________________________ +[ 8632] By: jhi on 2001/01/30 23:38:49 + Log: Integrate change #8396 from mainline. + + Subject: [PATCH] add SO_REUSEPORT to export list in Socket.pm for + better multicast support (resend) + Branch: maint-5.6/perl + !> ext/Socket/Socket.pm +____________________________________________________________________________ +[ 8631] By: jhi on 2001/01/30 23:28:03 + Log: Integrate changes #7514,7813,8113,8144,8397,8398,8490 from mainline. + + More AIX lore. (7514, ext/re/hints/aix.pl) + + Subject: Re: [PATCH bleadperl] Re: Not OK: perl5.7.0 +DEVEL7706 +Duseperlio on AIX4.[23] + + Subject: Re: [PATCH bleadperl] Re: Not OK: perl5.7.0 +DEVEL7706 +Duseperlio on AIX4.[23] (7813, strictly speaking not yet necessary, but harmless and goes well with #8490) + + Subject: [ID 20001214.002] Net::Ping patch + + Subject: [patch perl@8133] Typo in my Net::Ping doc patch :( + + Subject: [PATCH] add ReusePort option to IO::Socket::INET for better multicast support (resend) + + Add ReuseAddr as a (preferred) alias for Reuse as we now + also have ReusePort. + + Subject: [PATCH: perl@8482] minor typos in some dl_$foo.xs files + Branch: maint-5.6/perl + +> ext/re/hints/aix.pl + !> ext/DynaLoader/dl_aix.xs ext/DynaLoader/dl_dlopen.xs + !> ext/IO/lib/IO/Socket/INET.pm lib/Net/Ping.pm +____________________________________________________________________________ +[ 8630] By: jhi on 2001/01/30 23:03:59 + Log: Integrate changes #8215,8587 from mainline: missing pod nits. + + read() documentation tweak for 20001121.004. + + Subject: [ID 20010128.003] [PATCH] perlre.pod buglet + Branch: maint-5.6/perl + !> pod/perlfunc.pod pod/perlre.pod +____________________________________________________________________________ +[ 8629] By: jhi on 2001/01/30 22:41:57 + Log: Integrate change #8098 from mainline. + + fastgetcwd is defined using a glob alias on a $^O dependent basis + and there was no default assignment or perl subroutine. + Branch: maint-5.6/perl + !> lib/Cwd.pm +____________________________________________________________________________ +[ 8628] By: jhi on 2001/01/30 21:58:52 + Log: Integrate change #7866 from mainline. + + File::Temp 0.11. + Branch: maint-5.6/perl + !> lib/File/Temp.pm t/lib/ftmp-tempfile.t +____________________________________________________________________________ +[ 8627] By: jhi on 2001/01/30 21:39:44 + Log: Integrate changes #8075,8086,8228 from mainline. + + Darwin is not Windows. (8075,8086) + + Subject: [PATCH 5.6.1-TRIAL1 and @8223]; was Re: Perlbug 20000322.006 status +update + Branch: maint-5.6/perl + !> lib/CGI.pm lib/Pod/Select.pm lib/Text/ParseWords.pm + !> pod/perl.pod pod/perl5004delta.pod pod/perl5005delta.pod + !> pod/perldiag.pod pod/perlembed.pod pod/perlfaq4.pod + !> pod/perllocale.pod pod/perlmodlib.pod pod/perlretut.pod +____________________________________________________________________________ +[ 8626] By: jhi on 2001/01/30 21:22:11 + Log: Integrate with tweakery the change #8625 from mainline, + the multibyte decimal separator fix ("fa_IR locale failure"). + Branch: maint-5.6/perl + ! embedvar.h perlapi.h + !> intrpvar.h perl.c perl.h sv.c util.c +____________________________________________________________________________ +[ 8624] By: gsar on 2001/01/30 20:17:03 + Log: regen_headers + Branch: maint-5.6/perl + ! Makefile.SH pod/perlintern.pod +____________________________________________________________________________ +[ 8623] By: gsar on 2001/01/30 19:42:34 + Log: backout change#7431 and its dependents (causes spurious rebuilds + of autogenerated files) + + fix benign b.t failure + Branch: maint-5.6/perl + ! Makefile.SH t/lib/b.t +____________________________________________________________________________ +[ 8621] By: gsar on 2001/01/30 19:24:47 + Log: integrate changes#8259,8442,8444,8445,8448,8449,8451,8455 + from mainline + + Subject: podlators 1.06 released + + Subject: [PATCH @8436] Eliminate op_children + + (Replaced by #8448) Traces of op_children (cleanup of #8442) + + (Replaced by #8448) More op_children traces (cleanup of #8442). + + Subject: [PATCH #3 @8436] Re: Eliminate op_children + Replace #8444 and #8445. + + Under 5.005 threads and debugging crashed in Debian 2.2 Linux/x86 + at the setting of the ofs_sv in new_struct_thread() as the + thr->Tofs_sv (PL_ofs_sv) was still 0xabab.... (this is what + uninitialized fields are, uh, initialized with), + SvREFCNT_inc()ing that invited a core dump. + + podlators 1.07, from Russ Allbery. + + Subject: [PATCH] regcomp.c old feature removal + From: mjd@plover.com + Date: 16 Jan 2001 14:43:18 -0000 + Message-ID: <20010116144318.7140.qmail@plover.com> + Branch: maint-5.6/perl + +> lib/Pod/Text/Overstrike.pm + !> MANIFEST bytecode.pl ext/B/B.xs ext/B/B/Asmdata.pm + !> ext/B/B/Bytecode.pm ext/B/B/C.pm ext/B/B/Concise.pm + !> ext/B/B/Debug.pm ext/ByteLoader/byterun.c + !> ext/ByteLoader/byterun.h lib/Pod/Man.pm lib/Pod/Text/Color.pm + !> lib/Pod/Text/Termcap.pm op.c op.h pod/pod2text.PL regcomp.c + !> util.c +____________________________________________________________________________ +[ 8620] By: gsar on 2001/01/30 18:48:32 + Log: integrate changes#8243,8254,8255,8313,8314,8363,8383,8390,8416, + 8417,8418,8419,8424,8427,8430,8441,8563 from mainline (TODO: b.t + now fails one test) + + Subject: [PATCH] lvalue AUTOLOAD. No, really. + + Subject: [PATCH] Interesting syntax idea + Make opens + bareword assigns do typeglob assigns. + + Tests for #8254. + + Subject: [PATCH @8269] Continue blocks and B::Deparse + Make the peephole optimizer to bypass more null ops and + and rewrite the deparse handling of continue blocks. + + Subject: Re: [PATCH @8269] Continue blocks and B::Deparse + Doc tweak on #8313. + + Subject: [PATCH @8344] Fix spurious GVSV OPpOUR_INTRO + + Subject: [PATCH @8382] Remove FileHandle/IO dependence in t/io/openpid.t + + Subject: [PATCH perl@8269] Opcode.XS, fix memory leak + + Subject: RE: [PATCH] [ID 20001223.002] lvalues in list context + Replace 10000 with RETVAL_MAX, and compute RETVAL_MAX + according to the platform. + + Subject: [PATCH @8404] Consolidated lvalue sub changes + + Subject: Re: [PATCH] [ID 20001223.002] lvalues in list context + + Rename RETVAL_MAX to RETURN_UNLIMITED_NUMBER. + + Subject: B::Concise -- an improved replacement for B::Terse + + The B::Terse drop-in replacement wasn't quite drop-in. + + The LVRET macro needed an aTHX. + + Use the /^Perl_/-less form of is_lvalue_sub(). + + Subject: [PATCH @8545] [ID 20000808.005] OP_REFGEN as an lvalue + Branch: maint-5.6/perl + +> ext/B/B/Concise.pm + !> (integrate 27 files) +____________________________________________________________________________ +[ 8616] By: jhi on 2001/01/30 18:20:58 + Log: Integrate partly the change #8615 from mainline, the t/op/each.t + part isn't applicable to maintperl. + + UTF-8 nit from Inaba Hiroto. + Branch: maint-5.6/perl + !> pod/perlapi.pod utf8.c +____________________________________________________________________________ +[ 8613] By: gsar on 2001/01/30 16:39:59 + Log: make it possible to run the tests outside the source tree + (there's still a dependency on ../lib being the library + location) + Branch: maint-5.6/perl + ! t/base/term.t t/io/tell.t t/lib/dprof/V.pm t/op/flip.t +____________________________________________________________________________ +[ 8612] By: gsar on 2001/01/30 16:31:12 + Log: perldoc nit on windows + Branch: maint-5.6/perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 8611] By: gsar on 2001/01/30 16:22:54 + Log: canonicalize paths when doing chdir() on windows (or Cwd::getcwd() + gets weird results) + Branch: maint-5.6/perl + ! win32/vdir.h +____________________________________________________________________________ +[ 8610] By: gsar on 2001/01/30 16:12:45 + Log: avoid uninitialized value warnings + Branch: maint-5.6/perl + ! win32/bin/search.pl +____________________________________________________________________________ +[ 8609] By: gsar on 2001/01/30 16:08:01 + Log: support for -Dusethreads build under HP-UX 10.20 and DCE threads + library (11.0 and later have pthreads but 10.x don't) + Branch: maint-5.6/perl + ! hints/hpux.sh thread.h +____________________________________________________________________________ +[ 8608] By: gsar on 2001/01/30 15:48:55 + Log: perl's internal variables are not for public consumption, + move their docs from perlapi.pod to perlintern.pod + Branch: maint-5.6/perl + ! intrpvar.h perlapi.c pod/perlapi.pod pod/perlintern.pod + ! thrdvar.h +____________________________________________________________________________ +[ 8607] By: gsar on 2001/01/30 15:44:27 + Log: mistakenly branched perl56delta.pod, revert + Branch: maint-5.6/perl + - pod/perl56delta.pod + !> pod/perldelta.pod +____________________________________________________________________________ +[ 8606] By: gsar on 2001/01/30 14:20:24 + Log: integrate changes#7984,7987,8010 from mainline (gets rid of + dTHR which has been a noop for a while now, except for the + compatibility definition in thread.h) + Branch: maint-5.6/perl + !> (integrate 45 files) +____________________________________________________________________________ +[ 8605] By: jhi on 2001/01/30 05:43:58 + Log: Mark the UTF-8 APIs as experimental. + Branch: maint-5.6/perl + ! embed.pl pod/perlapi.pod +____________________________________________________________________________ +[ 8604] By: jhi on 2001/01/30 05:38:40 + Log: Nits from earlier integrates. + Branch: maint-5.6/perl + ! lib/Carp/Heavy.pm + !> sv.c +____________________________________________________________________________ +[ 8603] By: jhi on 2001/01/30 05:27:26 + Log: Regenerate Porting files. + Branch: maint-5.6/perl + ! Porting/Glossary Porting/config.sh Porting/config_H +____________________________________________________________________________ +[ 8602] By: jhi on 2001/01/30 05:14:59 + Log: Integrate changes #7891,8034,8078,8110,8111,8112,8277,8291, + 8310,8339,8447,8492,8493,8505,8525: documentation changes. + + Subject: Re: perlfaq style changes + + Subject: DOC PATCH 5.6.0: -s return value incompletely documented + + Subject: [PATCH] docs on NaN + + Subject: [patch] perlfaq7 + + Subject: [ID 20001214.003] [PATCH bleadperl] POSIX::tmpnam() is dangerous + + Subject: [PATCH] Re: [ID 20001013.006] XS subs are not define()ed + + Subject: [PATCH] open() example in perlfunc.pod + + Podify README.mpeix (a new version from the web) + + Subject: [PATCH 5.[67].1]; as Re: [PATCH 5.6.1-TRIAL1 and @8223]; was Re: Perlbug 20000322.006 status update + + Subject: [PATCH] format and rewording in perlfaq.pod + + Subject: [PATCH] API Variable documentation + + Memory management calls documentation. + + Subject: [PATCH: perl@8482] README.vms URL updates + + Subject: Minor typos in perlfaq2.pod + + Subject: [PATCH] pod/perlvar.pod + Branch: maint-5.6/perl + +> pod/perl56delta.pod + ! pod/buildtoc.PL pod/perl.pod pod/perltoc.pod + !> README.amiga README.epoc README.mpeix README.vms + !> ext/POSIX/POSIX.pod lib/CPAN.pm lib/Carp/Heavy.pm + !> lib/Win32.pod pod/perlapi.pod pod/perlfaq.pod pod/perlfaq1.pod + !> pod/perlfaq2.pod pod/perlfaq6.pod pod/perlfaq7.pod + !> pod/perlfunc.pod pod/perlop.pod pod/perlrequick.pod + !> pod/perlvar.pod thrdvar.h +____________________________________________________________________________ +[ 8601] By: jhi on 2001/01/30 04:38:35 + Log: Integrate changes #8036,8096,8253 from mainline: + hints changes. + + Subject: [ID 20001207.004] [PATCH 5.6.0 and 5.7.x] add NCR MP-RAS support + Subject: [8095] HP-UX 11.00 / cc / 64bitint & 64bitall / perlio + + Output the (apparent) version of gcc in Tru64. + Branch: maint-5.6/perl + +> ext/POSIX/hints/svr4.pl + !> MANIFEST ext/POSIX/Makefile.PL hints/dec_osf.sh hints/hpux.sh + !> hints/svr4.sh t/lib/bigfltpm.t +____________________________________________________________________________ +[ 8600] By: jhi on 2001/01/30 04:04:01 + Log: Integrate changes #7863,7868,7875,7876,7888,8384,8480 from mainline: + locale fixes. + + sprintf() does not taint since print() does not. (7863,7875,7876,7888) + + Debian allows /usr/bin/locale to exist without any locales. (7868) + + Allow the locale test needing POSIX and the taint test + needing IPC::SysV to run under 'minitest' (basically, + bail out if loading the extension fails). (8384) + + Cleanup the locale.t output (8480) + Branch: maint-5.6/perl + !> pod/perllocale.pod sv.c t/op/misc.t t/op/taint.t + !> t/pragma/locale.t +____________________________________________________________________________ +[ 8599] By: jhi on 2001/01/30 03:51:04 + Log: Missing generated files from #8598. + Branch: maint-5.6/perl + ! embed.h global.sym objXSUB.h perlapi.c proto.h +____________________________________________________________________________ +[ 8598] By: jhi on 2001/01/30 03:41:54 + Log: Integrate change #8555 from mainline, manually integrate parts + of changes 8452 and 8583. + + Subject: [PATCH] utf8.c documentation (8452) + + No point in checking the length if the pointer is bogus. (8555) + + Introduce bytes_from_utf8() and implement sv_eq() using it, + tr/// did not handle UTF-8 ranges, \ before a raw UTF-8 character + produced "Malformed UTF-8 character" warning, "\x{100}\N{CENT SIGN}" + was malformed. (8583) + Branch: maint-5.6/perl + ! embed.pl t/lib/charnames.t t/op/tr.t toke.c + !> pod/perlapi.pod sv.c utf8.c +____________________________________________________________________________ +[ 8597] By: gsar on 2001/01/30 02:37:26 + Log: get PERL_OBJECT build going again on windows + Branch: maint-5.6/perl + ! embed.h embed.pl global.sym objXSUB.h perlapi.c + ! pod/perlapi.pod proto.h sv.c +____________________________________________________________________________ +[ 8586] By: gsar on 2001/01/29 13:43:44 + Log: make the BOM detection code not call tell() until it has to + (meant to fix esoteric compatibility issues where PL_rsfp + is overridden) + Branch: maint-5.6/perl + ! toke.c +____________________________________________________________________________ +[ 8580] By: jhi on 2001/01/28 05:16:25 + Log: Revert the change to sv_2pv() done by #8054: Someone who + did SvNV_set() on a scalar that also happened to be POK, + followed by sv_2pv() won't get the right coercion anymore. + [Sarathy] + Branch: maint-5.6/perl + ! sv.c +____________________________________________________________________________ +[ 8579] By: jhi on 2001/01/28 05:15:04 + Log: Remove the #8084 effect: do not allow -Q to be interpreted + as -&Q(), this is too much wiggle room. + Branch: maint-5.6/perl + ! toke.c +____________________________________________________________________________ +[ 8578] By: jhi on 2001/01/28 05:12:45 + Log: Needed bits of #8439 (should have been in #8576), + mainly for lval substr(). + Branch: maint-5.6/perl + ! mg.c pp.c pp_hot.c +____________________________________________________________________________ +[ 8577] By: jhi on 2001/01/28 05:02:46 + Log: A missing check-in. + Branch: maint-5.6/perl + ! utf8.c +____________________________________________________________________________ +[ 8576] By: jhi on 2001/01/28 04:26:18 + Log: Integrate changes #8425,8436,8439,8517 from mainline. + The 8439 was not truly integrated because it had too many + dependencies on the development branch and because it introduced + concepts too bold for a maintenance branch (such as the qu operator). + + Subject: [PATCH perl@8342] -Wformat + + Tighten some of the UTF-8 tests a bit. + + More UTF-8 patches from Inaba Hiroto. (8439, but only partly) + - The substr lval was still not okay. + - Now pp_stringify and sv_setsv copies source's UTF8 flag + even if IN_BYTE. pp_stringify is called from fold_constants + at optimization phase and "\x{100}" was made SvUTF8_off under + use bytes (the bytes pragma is for "byte semantics" and not + for "do not produce UTF8 data") + Branch: maint-5.6/perl + ! t/lib/charnames.t t/op/substr.t toke.c + !> sv.c t/pragma/utf8.t +____________________________________________________________________________ +[ 8575] By: jhi on 2001/01/28 04:01:51 + Log: Integrate changes #8378,8379,8385,8386,8405 from mainline. + + Subject: One more patch for UTF8 (UTF-8 fixes for 'x' and tr////) + + Subject: [ID 20001230.003] UTF-8 tr still hurts + + Test cases for #8385 (from Simon's "torture.pl") + + Start fixing UTF-8 lval substr() (8405) + Branch: maint-5.6/perl + !> doop.c embed.h embed.pl mg.c op.c pod/perlapi.pod pp.c proto.h + !> regcomp.c regexec.c t/op/substr.t t/op/tr.t toke.c utf8.c +____________________________________________________________________________ +[ 8574] By: jhi on 2001/01/28 03:09:06 + Log: Integrate changes #8328,8329,8330,8331,8332,8341,8343,8377 + from mainline. + + UTF-8 cleanup. + + Subject: [PATCH perl@8327] strings with \x{..} in the middle are corrupted + + "\x{FF}\xFF" was broken. + + Tests for #8329 and #8330. + + Add a note about EBCDIC versus UTF-8 to a potential problem spot. + + IRIX compiler noticed that the bof initialization might be + bypassed by control flow. + + Make explicit our assumption that (for now) "\x{80}" produces UTF-8. + Branch: maint-5.6/perl + !> doop.c op.c pp.c pp_ctl.c pp_hot.c pp_sys.c regcomp.c + !> regexec.c sv.c t/op/bop.t toke.c utf8.c +____________________________________________________________________________ +[ 8572] By: jhi on 2001/01/28 02:04:49 + Log: Integrate changes #8267,8272[perlio],8274,8298,8300,8303, + 8305,8323,8324 from mainline. The 8267,8272, and 8298 were + not really integrated but instead salvaged by hand + (they had too many dependencies on the development release + to be cleanly integratable). + + Subject: more UTF8 test suites and an UTF8 patch + + Tweak for MULTIPLICITY/USE_PERLIO + + Signedness nit. + + Turn SvUTF8 off if not required in pp_chr and pp_stringify. + + Use the UTF8_XXX macros in is_utf8_char(). + + Rewrite pp_concat() in terms of sv_catsv(). The . operator + should now be UTF-8-proof. + + Subject: [PATCH perl@8269] scanning two hex-constants + fails on EBCDIC environment (script length.t) + + Add some Unicode chop() tests. + Branch: maint-5.6/perl + ! doop.c mg.c pp.c pp_hot.c toke.c utf8.c + !> sv.c t/op/chop.t utf8.h +____________________________________________________________________________ +[ 8571] By: jhi on 2001/01/28 00:35:59 + Log: Integrate changes #8090,8093[perlio,only the sv.c tweak], + 8245,8247,8248,8249,8250,8251,8260,8263,8264,8265 from mainline. + + Subject: [PATCH] Re: Breadperl & Tk (sv_utf8_upgrade fixes) + + The maxiters upper limit sanity check (guarding against + non-progress) assumed bytes instead of characters in s/// + and split(). + + Signedness nit. + + sv_catsv() rewrite (8248,8249,8251,8260,8263,8264,8265) + join() should now be UTF-8-proof. + + More split // UTF-8 tests. (8250) + Branch: maint-5.6/perl + !> doop.c hv.c pp.c pp_hot.c sv.c t/op/join.t utf8.c utf8.h + !> util.c +____________________________________________________________________________ +[ 8570] By: jhi on 2001/01/27 22:15:46 + Log: Integrate changes #7941,7943,7944,7958,7967,7995,7996,7998, + 8004,8005,8023,8024,8028,8030,8031,8033,8039,8042,8052[perlio], + 8053[perlio],8054[perlio,+sv.c(-PerlIO_isutf8),+require.t], + 8084,8204,8244,8333 from mainline. + + For -Q where Q might be a one-letter sub name one does no more + get a warning about an unknown filetest (7941,7943,7944,8084). + + Subject: Re: [ID 20001130.011] expression parsing bug ? + + Make uv_to_utf8() to zero-terminate its output buffer. + + Split off t/op/length.t (7995) + + Split off t/op/utf8decode.t (7996) + + Remove an unnecessary 'use utf8' from the utf8.t (7998) + + Split off t/op/concat.t (8004) + + Split off t/op/ver.t (8005) + + Document utf8_length(), utf8_distance(), and utf8_hop(). + + Document utf8_to_uv() better. + + Introduce macros for UTF8 decoding (8028,8033). + + Add test for reverse() (8030,8031). + + Subject: [PATCH] Re: ebcdic <-> ascii tables interjected in uv <-> utf8 considered harmful (8039,8333) + + Do not return the Unicode replacement character on UTF-8 + decoding failure. + + Typo/thinko in S_scan_const() - seeing high bit sets has_utf8 + not this_utf8 i.e. the output string has one, but don't mess + with source assumption. (8052,8053) + + Tweak t/comp/require.t to add a 'use bytes' to permit its dubious + writing of BOM to a non-utf8 stream. Fix SvPVutf8() - sv_2pv() + was not expecting to be called with something that was already + SvPOK() - (we just fossiked with SvUTF8 bit). Fix that and also + just use the SvPV macro in sv_2pvutf8() to avoid the issue/overhead. + (8054) + + Recode the naughty binary bytes in utf8decode.t using the \xHH. + + Make some panic messages a bit more logical. + Branch: maint-5.6/perl + +> t/op/concat.t t/op/length.t t/op/reverse.t t/op/utf8decode.t + !> MANIFEST doop.c embed.pl lib/ExtUtils/Liblist.pm op.c + !> pod/perlapi.pod pod/perldiag.pod pp.c pp_hot.c regcomp.c + !> regexec.c sv.c t/comp/require.t t/op/misc.t t/op/ver.t + !> t/pragma/utf8.t t/pragma/warn/toke t/pragma/warn/utf8 toke.c + !> utf8.c utf8.h +____________________________________________________________________________ +[ 8569] By: jhi on 2001/01/27 19:16:43 + Log: Integrate changes #7750 from perlio and #8566 from mainline. + Branch: maint-5.6/perl + !> regexec.c sv.c +____________________________________________________________________________ +[ 8568] By: jhi on 2001/01/27 18:06:51 + Log: Integrate changes #7355[-doio.c],7691,7744,7753[perlio], + 7783,7790[perlio],7869,7871,7872,7911,7916,7932, + 7935[-perlio.c],7936,7959,7965 from mainline. + + Change the "big byte" error message to "Wide character". + (7355, the croak-if-wide-chars-in-print part ignored) + + Use UINT64_C(). + + Introduce Perl_utf8_length(). + + diff -se shows these as different (7753, forgotten check-ins) + + Subject: [PATCH] doop.c - UTF8 tr/// + + If we use (aTHX_ ...) then put Perl_ on the front. + + Make utf8_length() and utf8_distance() to be less forgiving + about bad UTF-8. + + Test line numbers are different with utf8. + + No need to scan till infinity, 13 is enough. (7872,7911) + + Subject: [PATCH] Tokeniser debugging + + Subject: Re: question about retlen in utf8.c:Perl_utf8_to_uv() + + Subject: [PATCH perl@7930] toke.c perlio.c -Wformat nits (only toke.c) + + Be more careful in Perl_sv_utf8_downgrade(). + + Use DO_UTF8(). + + Raw zero bytes in text files confuse at least GNU patch 2.1. + Branch: maint-5.6/perl + !> doop.c embed.h embed.pl global.sym handy.h objXSUB.h op.c + !> perl.c perl.h perlapi.c pod/perlapi.pod pod/perldiag.pod + !> pod/perlrun.pod proto.h scope.h sv.c t/op/re_tests + !> t/pragma/utf8.t toke.c utf8.c utf8.h +____________________________________________________________________________ +[ 8553] By: jhi on 2001/01/26 15:19:39 + Log: Integrate change #7792 from perlio (multiplicity fix), + fix the AV leak in regex DEBUGGING (tiny part of the + polymorphic regexp patch #8143). + Branch: maint-5.6/perl + ! regcomp.c + !> scope.h +____________________________________________________________________________ +[ 8551] By: jhi on 2001/01/26 02:33:19 + Log: Integrate changes #7760,7815,7870,7873,7874,7877,7878,7879,7881, + 7937,7938,7939,7940,7968,7969,8403,8414,8510 from mainline. + + Subject: [PATCH 5.7.0] The first step in removing recursion from the REx engine + + Subject: [PATCH 5.7.0] Overeager visited-positions optimizations + + Message nit. + + BOUND regex opcodes (\b, \B) could try to scan zero length UTF-8. + + Debug dump of ANYOFUTF8 was garbage (data from ANYOF). + + (the cleanup of unused submatches in regtry() and regcppop()) + + Fix for 20001130.008 and 20001130.010, the PL_regnpar wasn't + stored and restored, and thusly was trounced by the utf8 swash + routines. + + use utf8 not required to use \x{}. + + Removed two more tests that make no sense in UTF-8 since the test + data is not in UTF-8. + + Get the three different space character classes right under utf8. + + Implement ANYOFUTF8 regprop() dumping. + + Subject: Re: [ID 20001029.005] Regex error: "cd. (A. Tw)" !~ /\((\w\. \w+)\)/ + + Document the regex context pushing/popping a bit better. + Branch: maint-5.6/perl + +> lib/unicode/Is/Blank.pl lib/unicode/Is/SpacePerl.pl + !> MANIFEST lib/unicode/mktables.PL pod/perlre.pod regcomp.c + !> regexec.c scope.h t/op/pat.t t/op/re_tests t/op/regexp.t + !> t/op/regmesg.t utf8.c +____________________________________________________________________________ +[ 8549] By: jhi on 2001/01/25 15:22:28 + Log: Undo 6475: { use utf8; chr(128..255) } is better off producing bytes. + Branch: maint-5.6/perl + ! pod/perlfunc.pod pp.c t/pragma/utf8.t +____________________________________________________________________________ +[ 8548] By: jhi on 2001/01/25 15:02:55 + Log: Integrate changes #7997,8063,8492,8547 from mainline. + + Subject: Re: STRLEN - what? + + Subject: [PATCH] perlguts.pod + + Memory management calls documentation. + + Layout using tabulator is not a good idea in a pod. + Branch: maint-5.6/perl + !> pod/perlguts.pod +____________________________________________________________________________ +[ 8546] By: jhi on 2001/01/25 14:31:12 + Log: Integrate changes #8188,8189,8208,8209,8210,8212,8374,8388 + from mainline. + + Subject: [DOC PATCH: perl@7953] update list of lang. sensitive editors/IDES + + Subject: [DOC PATCH: perl@8150, 5.6.1-TRIAL1] update list of lang. sensitive editors/IDES + + More Win32 editor/IDE/shell hints. + + More Win32 Perling. + + Yet another editor edit. + + Edit edit edit. + + IDE/editor section tweaking. + + Few more IDE/editor nits from p5p. + Branch: maint-5.6/perl + !> pod/perlfaq3.pod +____________________________________________________________________________ +[ 8543] By: jhi on 2001/01/25 03:52:08 + Log: Integrate change #8462,8469 from mainline. + + In VMS Perl subversion (perl -V) is undef. + Branch: maint-5.6/perl + !> configure.com +____________________________________________________________________________ +[ 8542] By: jhi on 2001/01/25 03:44:55 + Log: Integrate changes #7835,7850,8315,8316 from mainline. + + Solaris hints. + Branch: maint-5.6/perl + !> hints/solaris_2.sh +____________________________________________________________________________ +[ 8541] By: jhi on 2001/01/25 03:39:28 + Log: Integrate #8336 from mainline. + Branch: maint-5.6/perl + !> hv.c +____________________________________________________________________________ +[ 8540] By: jhi on 2001/01/25 03:23:50 + Log: Retract #8539. + Branch: maint-5.6/perl + ! pod/perlfaq3.pod +____________________________________________________________________________ +[ 8539] By: jhi on 2001/01/25 03:21:55 + Log: (Retracted by #8540.) + Branch: maint-5.6/perl + ! pod/perlfaq3.pod +____________________________________________________________________________ +[ 8538] By: jhi on 2001/01/25 03:14:07 + Log: Subject: [re-patch: 5.6.1-TRIAL1] was Re: [PATCH 5.6.1-TRIAL1]VMS buildpatches + From: Peter Prymmer + Date: Mon, 18 Dec 2000 13:10:35 -0800 (PST) + Message-ID: + + The VMS bits. + Branch: maint-5.6/perl + ! configure.com vms/descrip_mms.template +____________________________________________________________________________ +[ 8537] By: jhi on 2001/01/25 03:06:09 + Log: Integrate #7710,7824,7973 from mainline. + Branch: maint-5.6/perl + !> Configure Porting/Glossary Porting/config.sh Porting/config_H + !> config_h.SH configure.com epoc/config.sh hints/aix.sh malloc.c + !> regcomp.c sv.c vos/config.alpha.def vos/config.alpha.h + !> vos/config.ga.def vos/config.ga.h win32/config.bc + !> win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 8536] By: jhi on 2001/01/24 13:50:20 + Log: Revert the edits made by me so far to the 5.6 branch since + the TRIAL1 since I did edits when I should have been using + integrates. Bad programmer. (Will integrate them properly later.) + Undoes #8347, #8349, #8350, #8351, #8353, #8355, #8376, #8463, #8470. + The #8353 will not be reapplied at least for now since + the UTF-8 hash keys need more thinking. + (The patches #8347, #8354, #8454, #8473 were okay since they + were original edits made specifically for the 5.6.1-TRIAL1.) + Branch: maint-5.6/perl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH configure.com embed.pl epoc/config.sh hints/aix.sh + ! hints/solaris_2.sh hv.c hv.h malloc.c perlapi.c + ! pod/perlapi.pod pod/perlfaq3.pod proto.h regcomp.c sv.c + ! t/op/each.t vms/descrip_mms.template vos/config.alpha.def + ! vos/config.alpha.h vos/config.ga.def vos/config.ga.h + ! win32/config.bc win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 8473] By: gsar on 2001/01/18 11:42:31 + Log: unsubmitted trial1 change + Branch: maint-5.6/perl + ! Changes +____________________________________________________________________________ +[ 8470] By: jhi on 2001/01/18 04:16:00 + Log: Subject: [PATCH: perl@8453] Re: subversion undef on VMS (was Re: [ID 20001218.033] Not OK: perl v5.6.1 +v5.6.1-TRIAL1 on VMS_AXP V7.2-1) + From: Peter Prymmer + Date: Wed, 17 Jan 2001 13:07:11 -0800 (PST) + Message-ID: + Replace #8463. + Branch: maint-5.6/perl + ! configure.com +____________________________________________________________________________ +[ 8463] By: jhi on 2001/01/17 06:12:42 + Log: (Replaced by #8470) + + Subject: subversion undef on VMS (was Re: [ID 20001218.033] Not OK: perl v5.6.1 +v5.6.1-TRIAL1 on VMS_AXP V7.2-1) + From: "Craig A. Berry" + Date: Tue, 16 Jan 2001 23:38:46 -0600 + Message-Id: + Branch: maint-5.6/perl + ! configure.com +____________________________________________________________________________ +[ 8454] By: jhi on 2001/01/16 16:12:39 + Log: Subject: [PATCH: perl-5.6.1-TRIAL1] Win32 Makefile fixes - v2 + From: "Indy Singh" + Date: Wed, 10 Jan 2001 20:17:49 -0500 + Message-ID: <003001c07b6c$524630b0$00957018@roadhog> + Branch: maint-5.6/perl + ! win32/Makefile +____________________________________________________________________________ +[ 8376] By: jhi on 2001/01/09 04:32:32 + Log: integrate changes #7775, #8316, #8316 from mainline + Branch: maint-5.6/perl + ! hints/solaris_2.sh +____________________________________________________________________________ +[ 8357] By: jhi on 2001/01/07 21:16:09 + Log: Update the EPOC cross SDK URL. + Branch: maint-5.6/perl + ! README.epoc +____________________________________________________________________________ +[ 8355] By: jhi on 2001/01/06 20:27:15 + Log: integrate change #8336 from mainline + + Scoping of %^H still broken in both perl@8269 and perl-5.6.1-TRIAL1 + Branch: maint-5.6/perl + ! hv.c +____________________________________________________________________________ +[ 8354] By: jhi on 2001/01/06 20:24:29 + Log: Subject: [PATCH 5.6.1-TRIAL1 and @8223]; was Re: Perlbug 20000322.006 status update + From: Robin Barker + Date: Fri, 22 Dec 2000 12:17:38 GMT + Message-Id: <200012221217.MAA21332@tempest.npl.co.uk> + + The patch reformats some long =item lines so they give + correct output via pod2man | nroff -man + + Subject: [PATCH 5.[67].1]; as Re: [PATCH 5.6.1-TRIAL1 and @8223]; was Re: Perlbug 20000322.006 status update + From: Robin Barker + Date: Tue, 2 Jan 2001 15:35:03 GMT + Message-Id: <200101021535.PAA15161@tempest.npl.co.uk> + + Here is a _further_ patch which corrects a few more errors: + * an empty C<=item> in CPAN.pm + * patching the wrong file (pod/perlamiga.pod not README.amiga) + * leaving empty C<=item>s which formatted incorrectly + * over long C<=item>s revealed by latest patch to Pod::Man + Branch: maint-5.6/perl + ! README.amiga lib/CGI.pm lib/CPAN.pm lib/Pod/Select.pm + ! lib/Text/ParseWords.pm lib/Win32.pod pod/perl.pod + ! pod/perl5004delta.pod pod/perl5005delta.pod pod/perlapi.pod + ! pod/perldelta.pod pod/perldiag.pod pod/perlembed.pod + ! pod/perlfaq4.pod pod/perllocale.pod pod/perlmodlib.pod + ! pod/perlrequick.pod pod/perlretut.pod pod/perlsub.pod +____________________________________________________________________________ +[ 8353] By: jhi on 2001/01/06 20:21:10 + Log: integrate changes #7980, 8056, 8057 from mainline + + UTF-8 hash keys. + Branch: maint-5.6/perl + ! embed.h embed.pl hv.c hv.h perlapi.c proto.h t/op/each.t +____________________________________________________________________________ +[ 8352] By: jhi on 2001/01/06 20:18:44 + Log: Forgotten from #8438. + Branch: maint-5.6/perl + ! epoc/epocish.h +____________________________________________________________________________ +[ 8351] By: jhi on 2001/01/06 20:18:12 + Log: Forgotten from #8347. + Branch: maint-5.6/perl + ! config_h.SH +____________________________________________________________________________ +[ 8350] By: jhi on 2001/01/06 20:00:19 + Log: Thinko in #8347. + Branch: maint-5.6/perl + ! regcomp.c +____________________________________________________________________________ +[ 8349] By: jhi on 2001/01/06 18:05:30 + Log: Copy the FAQ3 IDE section from the development branch, + changes originally by Peter Prymmer. + Branch: maint-5.6/perl + ! pod/perlfaq3.pod +____________________________________________________________________________ +[ 8348] By: jhi on 2001/01/06 18:03:02 + Log: EPOC updates for TRIAL1. + + Subject: [5.6.1 trial1] EPOC update + From: Olaf Flebbe + Date: Sun, 31 Dec 2000 16:04:52 +0100 (CET) + Message-ID: + + Subject: epoc patch2 for perl-5.6.1-trial1 + From: Olaf Flebbe + Date: Sat, 6 Jan 2001 13:55:53 +0100 (CET) + Message-ID: + Branch: maint-5.6/perl + ! README.epoc epoc/config.sh epoc/createpkg.pl epoc/epoc.c + ! epoc/epocish.c +____________________________________________________________________________ +[ 8347] By: jhi on 2001/01/06 17:29:10 + Log: integrate changes #7710,7824,7973 from mainline, + plus VMS nits from Peter Prymmer and Dan Sugalski. + + AIX 4.2 (using latest patchlevels on 20001130) has a broken bind + library (getprotobyname and getprotobynumber are outversioned by + the same calls in libc, at least for xlc version 3. + + Add HAS_SBRK_PROTO. + + Fixes for signedness warnings noticed by VMSperlers. + Branch: maint-5.6/perl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! configure.com epoc/config.sh hints/aix.sh malloc.c regcomp.c + ! sv.c vms/descrip_mms.template vos/config.alpha.def + ! vos/config.alpha.h vos/config.ga.def vos/config.ga.h + ! win32/config.bc win32/config.gc win32/config.vc + +____________________________________________________________________________ +[ 8182] By: gsar on 2000/12/18 09:53:47 + Log: delete spurious files + Branch: maint-5.6/perl + - lib/CGI/eg/make_links.pl lib/CGI/eg/wilogo.gif vos/config.def + - vos/config.h vos/config_h.SH_orig +____________________________________________________________________________ +[ 8181] By: gsar on 2000/12/18 09:46:08 + Log: regen perltoc + Branch: maint-5.6/perl + ! pod/buildtoc.PL pod/perl.pod pod/perlapi.pod pod/perltoc.pod +____________________________________________________________________________ +[ 8180] By: gsar on 2000/12/18 09:20:27 + Log: integrate changes#7924..7926,7946,7952 from mainline + + A test works better if it has the right 1..$n output. + + All the core library users of Class::Struct seem to be + using "use Class::Struct 'struct';" instead of the bare + "use Class::Struct;", which isn't documented in Class::Struct. + This can't be right. + + Make the Class::Struct import() wiser. + + Upgrade to CPAN 1.59_51, from Andreas König. + + Subject: Re: long shell lines + Split overly long shell command lines. + Branch: maint-5.6/perl + !> lib/CPAN.pm lib/CPAN/FirstTime.pm lib/ExtUtils/MM_Unix.pm + !> lib/File/stat.pm t/lib/class-struct.t +____________________________________________________________________________ +[ 8179] By: gsar on 2000/12/18 08:55:54 + Log: integrate changes#7889,7890,7900,7903,7904,7907,7910,7917, + 7918,7919,7988,8907 from mainline (various) + + Subject: [ID 20001127.004] White space problem in perlamiga.pod + + Subject: [PATCH perl@7825] Re: [ID 20001122.006] weird behaviour of $| + + Subject: [PATCH] perlcc.PL cleanups + + Subject: [PATCH] Updating perltie.pod for arrays + + Subject: [ID 20001128.002] what's the point of example code if it is buggy? + Subject: Re: [PATCH] Updating perltie.pod for arrays + Subject: Re: [PATCH] Updating perltie.pod for arrays + + One more perltie.pod nit from Casey R. Tweten. + + Subject: [PATCH] $^O win32 -> MSWin32 + plus similar nits for vms, err, VMS, and UNICOS. + + Subject: Re: Minor suggestion for Sys::Syslog [PATCH] + More checking in case someone has broken their services or + protocol databases. + + Make "use Class::Struct 'struct';" work again (broken by #7617); + add a test for Class::Struct. + + Integrate the "skip" messages to explain(). + + Subject: [PATCH: perl@8892] treat unicoding and null bytes in op/append.t + Branch: maint-5.6/perl + +> t/lib/class-struct.t + !> MANIFEST README.amiga ext/Sys/Syslog/Syslog.pm gv.c + !> lib/Class/Struct.pm pod/perlipc.pod pod/perltie.pod + !> t/lib/syslfs.t t/op/lfs.t utils/perlcc.PL +____________________________________________________________________________ +[ 8178] By: gsar on 2000/12/18 08:16:30 + Log: avoid redefinition warnings on windows due to sys/socket.h getting + #included before win32.h + Branch: maint-5.6/perl + ! win32/include/sys/socket.h +____________________________________________________________________________ +[ 8177] By: gsar on 2000/12/18 05:24:04 + Log: make regen_headers; fix POSIX.xs problems; remove outdated + code from sys/socket.h that makes build fail now + Branch: maint-5.6/perl + ! ext/POSIX/POSIX.xs global.sym objXSUB.h perlapi.c + ! pod/perlapi.pod + !> win32/include/sys/socket.h +____________________________________________________________________________ +[ 8176] By: gsar on 2000/12/18 05:20:17 + Log: update Changes + Branch: maint-5.6/perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 8175] By: gsar on 2000/12/18 04:57:48 + Log: integrate changes#7643,7646..7649,7651..7654,7658,7659, + 7661..7665,7667..7669,7671,7673,7676,7677,7681..7683, + 7689..7697,7699..7701,7703,7705,7714,7715,7718..7723, + 7725,7726,7729..7732,7737,7748,7749,7758,7759,7761,7773, + 7775,7776,7782,7785..7787,7804,7807,7808,7810,7811,7816, + 7823,7825,7838 + + Subject: Re: [PATCH] README.solaris + + Add getpagesize() probing, on non-UNIX guess 'undef'. + + Simplify the getpagesize() unit by dropping the + pagesize probe since it's nowadays slightly more + complicated because of sysconf(). (Note: if some + platform really needs the -lPW for getpagesize, + I just broke it.) + TODO: a new pagesize unit. + + Subject: [PATCH] fwd: Re: [ID 20001105.011] Perl 5.6.0 documentation glitch + + MachTen doesn't really do mmap() and munmap(). + Subject: [PATCHES Bleadperl] Re: PerlIO - what all of you can all do. + + More README.solaris updates from Andy Dougherty. + + Copy the s// information of README.hpux also to the perlrun. + + Add HAS_FSYNC, lack noticed by Nicholas Clark. + + Add a metaconfig unit for fsync. + + Subject: [ID 20001112.004] man perlfunc omits tell()'s error return + + Many subdocumented return values of the IO extension now documented. + ungetc and write still left subdocumented. + Subject: [PATCH] (was Re: IO::Handle::ungetc) + + Document tell() on special streams. + + Subject: [ID 20001112.006] IO::Seekable::getpos doesn't check for fgetpos() failure + + Subject: [ID 20001112.007] sfio's sftell isn't ftell + + Couple of tests from #7660 salvaged. + + Tweak the definition of the bit complement on UTF-8 data: + if none of the characters in the string are > 0xff, + the result is a complemented byte string, not a (UTF-8) + char string. Based on the summary in + Subject: Re: [ID 20000918.005] ~ on wide chars + This should give us the maximum backward (pre-char string) + compatibility and utf8 compatibility. The other alternative + would be to limit the bit complement to be always byte only, + taking the least significant byte of the chars. + + Cleanup messy #ifdef. + + Typos in #7667. + + Declare reg_data like reg_substr_data. + + Placate nervous compilers that see longer than ints switch()ing. + + Remove the new two tests of lib/io_xs for now, they seem to + fail under perlio on some platforms. + + Subject: Re: [ID 20001112.008] perlio.c's PerlIO_getpos ingores error return + + Subject: [ID 20001113.003] utf8_to_uv on malformed utf returns wrong values + + Subject: tiny typo in perl5db.pl + + Subject: some additions for makefiles for win32 (for perl@7674) + + Hoist the duplicated socket/netdb include logic to perl.h; + undef SETERRNO in case SOCKS has defined it. Based on: + Subject: [ID 20001114.002] Code-Cleanups concerning SOCKS5 and Solaris + + Regen Configure. + + Defined INT64_C() and UINT64_C() unless defined by + (a macro to define signed and unsigned integer constants). + + Use UINT64_C(). + Subject: [ID 20001114.006] 5.7.0-7680 Solaris 8, 64 bit, utf8 patch + + Use u_int32_t for the size of hash_cb(), not size_t. + Subject: [ID 20001114.003] Solaris 8, 64 Bit DB_file patch + + Quit utf8_to_uv() instantly if curlen == 0. + + Subject: [PATCH: perl@7674] updates to README.os390 + + Subject: [PATCH: perl@7674 + Scott-Thoennes] hush warnings about malformed EBCDIC text + + EBCDIC tweaks. + Subject: [PATCH: perl@7674 ++] fixes for warnings and regmesg (reprise) + + Linenumber fix. + + SOCKS has its own USE_THREADS, based on + Subject: [ID 20001114.002] et. al. bugfix followup + + UINT64_C() work continues. + + Detypo. + + The type of the hash_cb() size argument is tricky. + + Add fwalk() probe to the configuration files and regen perltoc. + + Subject: perllocale.pod changes + + Avoid an infinite loop in VMS when utils scripts are run + with no arguments, from Charles Lane. + + Subject: Re: Bug in Carp::Heavy/5.6.0? + + For Solaris use64bitall the stdchar needs a little bit of help. + + The long double hints can be here or there. + + Test tweak for the open pragma. + + Also the 64bitall hints can be either here or there. + + As surmised the #7719 wasn't a good move. + + Subject: Fix for 20000409.001 + + Subject: Fix for 20000815.006 + It's really 20000518.006. + + Subject: [PATCH 5.6.0 README.win32] very minor typos + + Subject: Fix for README.amiga (20000323.033) + + Explain in more detail the {} syntax ambiguousity. + Subject: [PATCH] Re: [ID 20001117.003] map { "$_", 1} @array is syntax error + + Sparc 64-bit pack() fix from Jens Hamisch. + + Upgrade to CPAN.pm 1.58_93 (the RC1 for 1.59), from Andreas König. + + Subject: podlators 1.05 available + + Subject: [ID 20001118.006] [PATCH] perl@7707 djgpp/config.over, hints/dos_djgpp.sh and Storable.pm + + Subject: [perl 7711: EPOC] updates + + Make certain MacOS Classic has NO_ENVIRON_ARRAY. + + Miraculous typo. + + sysseek() instead of seek(). + + Solaris hints tweaks. + + Assume SOCKS is broken in all 64bitall platforms, not just Solaris. + This may be overly harsh but until proven otherwise, we think this + way, or until we have a simple test for Configure (having to start + up servers is does not count as simple) to check for the problems. + + Remove the shared object before attempting to create + (by linking) a new one. E.g. in AIX not removing + becomes quite painful if one tries to do more than one + build in the same tree (an interrupted build, for example), + since the AIX' shared dynaloader seemingly keeps the shared + objects open and therefore 'busy' for quite a while, even when + nobody is using the objects, leading into link failures. + + Subject: [ID 20001120.010] typo in lib/Cwd.pm broke Cwd::chdir + + Subject: DOC PATCH 5.6.0 perlreftut + + Subject: [PATCH: perl@7777] add system locale testing for VMS + + Subject: [PATCH] Test.pm POD peculiarity + + Subject: [ID 20001120.002] [PATCH] io_sock.t fails without 'localhost' + + Subject: [ID 20001120.003] [PATCH] io_udp.t fails without 'localhost' + + Subject: Re: perl@7777 + Detypoing. + + Subject: [PATCH: perl@7777] make VMS' test.com tail compatible w/ unix + + Go ahead and #include in perl.h. + + Subject: [PATCH perl@7795] small cleanup task for test suite + + Subject: Re: av.c patch (having slight problems) + unshift() speedup. + + Reach back one higher up when searching for PERL_SRC. + Branch: maint-5.6/perl + +> lib/File/Spec/Epoc.pm + !> (integrate 88 files) +____________________________________________________________________________ +[ 8174] By: gsar on 2000/12/18 03:53:09 + Log: integrate changes#7602,7604..7611,7614,7616..7619,7621..7623, + 7625..7629,7631..7634,7637,7639,7642 from mainline + + Fix for the tie-refhash string table leaks. + + Subject: [patch perl@7595] VMS configure.com tweak + + More careful detection of how well NVs and UVs mix. + Subject: [PATCH] Re: NV preserving UV (wasRe: [ID 20001007.002] Not OK: perl v5.7.0 +DEVEL7158 on armv4l-linux-64int 2.2.17-rmk1 (UNINSTALLED)) + Added some SIGFPE paranoia. + + Forgot to bump the line numbers in #7601. + + Subject: PATCH std stdio for (Free)BSD + + Deleting $ENV{PATH} in VMS is not recommendable. + + Locale buglets. + Subject: RE: Locales support (setlocale) fixes + + Do not test UTF-8 locales since that the tests would require + polymorphic regexen. + + Subject: [PATCH bleadperl] Re: Patch 7533 prevents malloc.c from compiling on MachTen + + A missing aTHX_. + + Subject: [ID 20001108.013] spelling + + Subject: [PATCH] Class::Struct at compile time + + Make deleting for %ENV work for (newer versions of) VMS, + from Craig A. Berry. + + Forgot from #7618. + + More VMS moves on environment handling, from Charles Lane. + + Remove unused extra arguments. + + Typo in an ifndef. + Subject: Re: [PATCH 5.7.0] better messages from malloc() + + Subject: [PATCH: perl@7613] updates to Porting/pumpkin.pod + All except the "cow orker" change. + + The generated boot_* headers are wrong. Pickier compiler, + such as KAI C++ will refuse to compile the resulting perlmain. + Subject: [ID 20001109.005] Bug in minimod.pl, perl 5.6.0 + + There's no =head3. + + Disable only the tests 99 and 166 for UTF-8 locales. + + Missing dTHXs. + Subject: RE: perl@7595 builds not on cygwin + + Subject: Re: bash -c exit and linux hints + + Various doc oddball characters. + Subject: [ID 20001106.004] Perl 5.6.0 bugs + + Subject: [PATCH] IO::Seekable pod + + Amdahl UTS hints updates. + Subject: [ID 20001109.016] Trouble going from 5.4 to 5.6 + + Explain better why certain regex tests are skipped. + Subject: Re: tests skipped: unknown reason + + Subject: [PATCH] README.solaris + + Subject: [PATCH perl@7638] cygwin port + Branch: maint-5.6/perl + +> README.solaris + !> (integrate 26 files) +____________________________________________________________________________ +[ 8173] By: gsar on 2000/12/18 03:37:02 + Log: integrate changes#7472,7474..7478,7481,7485,7489,7493,7494,7496, + 7497,7499..7503,7505..7507,7509..7513,7515..7523,7526..7534, + 7536,7540,7542,7544..7546,7549,7553,7556,7557,7559,7561..7563, + 7565,7568..7572,7576,7578..7589,9592..7594,7596..7601 from mainline + + Better create a true mailing list for the repository keepers. + + Subject: [ID 20001027.007] uniq array in perlfaq + + De-quoted-unreadable to ISO Latin 1. + (There's one ISO-2022-JP name in Changes5.004.) + + Have only one master list of AUTHORS, drop unmaintained MAINTAIN. + + The #7476 needs a MANIFEST change, too. + + Add also emailless people. + + UTF-8 decoder tweak. + + Make \x{...} consistently produce UTF-8. + Subject: Re: \x{...} is confused + + Subject: [Chris Winters ] patch to ExtUtils::Manifest + + Add a perlbug flag, -A, to avoid acknowledgement messages. + Subject: PATCH (Re: [ID 20001030.008] OK: perl v5.7.0 +DEVEL7445 on i586-linux 2.2.16 (UNINSTALLED)) + + Use Errno magic. + Subject: [ID 20001030.009] [PATCH] ftmp-mktemp failing + + Subject: [PATCH: perl@7483] CRLF fix for cgi-function.t tests + + Subject: [PATCH: perl@7483] fix coded control chars in cgi-html.t + + Subject: [ID 20001030.001] 5.7.0-7489: Null-Pointer reference in mg.c + + Be more lenient on bad UTF-8 when doing bit arithmetics. + Subject: Re: [ID 20000918.005] ~ on wide chars + (The ord() part of the patch skipped.) + + Subject: perlfaq style changes + + AUTHORS tweaks. + + Whitespace style tweak. Was originally going to see to + Subject: PATCH (Re: PerlIO - Configure tweak for Linux/glibc?) + but that had already been taken care of. + + The compiler is either gcc or cc, from Tom Bates. + + The osname has been lowercased by now, from Tom Bates. + + The NonStop-UX libraries have a novel way to say NaN. + + printf UVs the correct way, noticed by Robin Barker. + + Subject: [PATCH] startperl to respect versiononly + + AUTHORS updates. + + Subject: [ID 20001031.004] Uninitialized auto variable in regcomp.c + + Subject: [ID 20001101.001] Net::Ping icmp odd $bytes + + Subject: [ID 20001005.004] doc bug: perlsec misleading re file output + + Generalize the Camel wording. + Subject: Re: perlfaq style changes + + Subject: [ID 20001005.006] Documentation -- description of qr// + + C.pm part of + Subject: [ID 20001010.001] [Daniel.Stutz@astaro.de: perlcc and C.pm in perl-5.7.0] + + Locale warning explanation tweak. + + Subject: [ID 20000904.004] perlsec Manual Page Incorrect Doing "Safe Backticks" + + Make the POSIX::setuid and POSIX::setgid to really call setuid() + and setgid() because they were just changing $< and $( which means + only changing the real uid/gid, as opposed to changing both + real and effective ids. (The alternative way could have been + in POSIX.pm to change $> and $), too, but making a direct call + to the C API feels cleaner.) Fixes the bug + Subject: [ID 20000904.005] POSIX::setuid() Doesn't Call setuid() + + Expand %Config variables and %ENV variables only if + so requested during build time using the + PERL_BUILD_EXPAND_CONFIG_VARS and PERL_BUILD_EXPAND_ENV_VARS. + Not expanding makes relocating distributions easier. + + More tweaking on the #7522 theme. + + Test::Harness revealed buglets in the new DynaLoader. + Subject: [ID 20001102.001] Not OK: perl v5.7.0 +DEVEL7523 on i686-linux 2.2.16a (UNINSTALLED) + + Add Tie::RefHash::Nestable (lives in Tie/RefHash.pm), + fix a autovivification bug in Tie::RefHash, add tests for both. + Subject: Re: Tie::RefHash: use hash refs as keys in nested hashes + + Detpyo. + + recv() can fail and return undef. + Subject: [ID 20001102.003] Net::Ping patch: "Bad arg lenght" error appears if host is unreachable + + Fix the problem discussed in + Subject: [ID 20001015.004] Fwd: Tie::SubstrHash -- bug & fix (all Perl versions) + originally from Linc Madison. Also Andreas König's comments + taken into account. Some other problems with Tie::SubstrHash + fixed: didn't croak when the table exceeded the requested number + of entries (as documented) but instead when the number of entries + exceeded the size of the table, a croak() had an unnecessary \n, + didn't have a CLEAR method, documented that there is no exists(). + Didn't fix to be strict-proof because the module uses &foo; and + dynamic scope. Added a test script exercizing both first tamely + the basic functionality, and then the failure cases reported by + Linc Madison. + + Subject: [PATCH] Perl@7504, vms/gen_shrfls.pl + + The #7521 touched things it shouldn't have. + + Subject: [PATCH 5.7.0] better messages from malloc() + + Subject: Re: README.aix + + Add FCNTL_CAN_LOCK. + Subject: Re: [ID 20001030.011] Not OK: perl v5.7.0 +DEVEL7481 on VMS_AXP V7.1 (UNINSTALLED) + Subject: Re: [ID 20001030.011] Not OK: perl v5.7.0 +DEVEL7481 on VMS_AXP V7.1 (UNINSTALLED) + + Locale tweakery. Add test case for bug id 20000809.003 to op/misc, + create a "fast path" for locale name probing using "locale -a" + if available, squash finally hopefully the s?printf resetting + the numeric locale (since, IIUC perllocale, it never shouldn't). + + More Changes tweakery. + + Dying is too strict here, better just skip. + + Subject: Locales support (setlocale) fixes + Modified quite a bit to be more portable. + + Configure would use a bad $myuname from an old config.sh. + Subject: [PATCH 5.6.1-to-be and 5.7.x] Very old Configure myuname bug + + Fix for + Subject: [ID 20001004.006] undef is never tainted + An undef read from a slurped file was not tainted. + + Fix for + Subject: [ID 20001004.007] taint propogation is inconsistent + The culprit was sv_setsv() which was rather blindly + propagating taint, which lead to behaviour where if + a tainted anon hash value was seen all the hash values + from then on at that level became tainted, or at any + upper levels in the case of nested anon hashes. + + Test tweak: show also the failed locales. + Subject: [ID 20001105.001] Not OK: perl v5.7.0 +DEVEL7523 on i86pc-solaris 2.8 + + A fix of sorts for 20000329.026, a better error message + for a missing "use charnames" when using the \N{...}. + + Subject: [Corrected/tested PATCH] Re: [ID 20001102.008] Not OK: perl v5.7.0 +DEVEL7503 on i686-linux 2.2.16 + + Add =pod to be tidy. + + Fix for bug id 19990615.008, pos() unset during s///ge. + + Add a note for future generations about bug id 20000229.006. + + Use -dM for gcc (the suggested patch did it only for Linux, + but I think it can be generalized). + Subject: Re: connect and $!{EINPROGRESS} pb (was [ID 20001030.010] [PATCH] io_multihomed.t failing) + + opmini.o can linger from Configures past. + + Document that the evaled syntax errors cause scalar leaks. + + Fix for + Subject: [ID 20000728.005] perl -P broken + (hopefully). The fix is also not complete, it seems to break + BOM swallowing for libc5 systems, but until someone figures + out a way to do this without ftell(), this will do. + + AUTHORS updates. + + Subject: Re: rsync'ed patches vs. rsync'ed source + + Admit that the test leaks scalars. + + Sanitize the environment further. + + VOS updates from Paul Green. + + Document %ENV = () portability issues. + + Make the stdio test program of 7427 less noisy while being + compiled so that Digital UNIX wouldn't get both + d_stdio_ptr_lval_nochange_cnt and d_stdio_ptr_lval_sets_cnt + undefined. This makes perlio happy. + + glibc5 detection by __GNU_LIBRARY__. + + %ENV note tweaks from Dan Sugalski. + + Varargs don't always work too well if one puts an unsigned + char on the stack and pop an unsigned quad off the stack. + Subject: Re: [ID 20001103.002] Not OK: perl v5.7.0 +DEVEL7523 on os2-64int-ld-2.30 (UNINSTALLED) + + Subject: Pod updates + + Fake support of holey files in win/dosish platforms. + Subject: SDBM_File under MS-Windows95/98 does not work correctly. (APR#1302) + + A doc addition for bug id 20001105.019, beware \p. + + Tweak #7587. + + Subject: [PATCH perl@7573] configure.com and st-lock.t changes for + + perlhack updates from H.Merijn Brand. + + Subject: [PATCH perl@7573] cygwin port + Synchronize with Cygwin 1.1.5. + + Bad thinko in #7581 (I used the test program with the expanded + values as-is). + + Make perlbug not insist on dumping to a file when stdout isn't a tty. + Subject: [PATCH] perlbug.PL + + Overrideable keys, each, pop, push, shift, splice, unshift. + Subject: [PATCH] prototyped functions that should be overrideable + + Try to avoid flockless and emulationless places. + Branch: maint-5.6/perl + +> t/lib/tie-refhash.t t/lib/tie-substrhash.t + - MAINTAIN + !> (integrate 111 files) +____________________________________________________________________________ +[ 8171] By: gsar on 2000/12/18 02:49:24 + Log: integrate changes#7447,7448,7450,7454,7456,7457,7460,7462, + 7465..7471 from mainline + + Remains of the old UTF-8 API, utf8_to_uv_chk(): didn't link + in platforms that strictly require all the symbols being present + at link time. + + Subject: [PATCH: perl@7446] restore missing d_stdio_cnt_lval to VMS + + Subject: [ID 20001025.011] [PATCH] t/io/open.t perl@7369[ 7350] breaks VMS perl + + Subject: [ID 20001026.006] C gives uninitialized warning + + Subject: [PATCH] todo + + Subject: [ID 20001027.002] Patch 7380 followup - Perl_modfl *must* be defined + + Use $sort, $uniq (and $tr) consistently as wondered + by Nicholas Clark. + + Too enthusiastic editing in #7460. + + The reëntrant version shouldn't be needed unless USE_PURE_BISON. + + Upgrade to CPAN 1.58_55. + Subject: CPAN.pm status + + Subject: [ID 20001027.005] Nit in perlos2.pod - space needs deleted on line 118 + + Make target reordering to avoid pointless re-makes. + Subject: Re: Total re-make of 'make okfile' after 7451 ? + + Subject: [ID 20001027.010] [PATCH] Add info on building CPAN modules to README.dos + + Subject: DOC PATCH 5.6.0 + + Add the repository doc by Malcolm, Sarathy, and by Simon, + name as suggested by Michael Bletzinger . + Branch: maint-5.6/perl + +> Porting/repository.pod + !> Configure MANIFEST Makefile.SH README.dos README.os2 + !> config_h.SH configure.com embed.h embed.pl handy.h lib/CPAN.pm + !> lib/CPAN/FirstTime.pm perl.h pod/perlfunc.pod pod/perltodo.pod + !> pp.c proto.h t/io/open.t t/op/assignwarn.t toke.c +____________________________________________________________________________ +[ 8169] By: gsar on 2000/12/18 02:33:34 + Log: integrate changes#7416,7417,7420..7422,7424,7426..7429,7431..7433, + 7435..7441,7445 from mainline + + Make the UTF-8 decoding stricter and more verbose when + malformation happens. This involved adding an argument + to utf8_to_uv_chk(), which involved changing its prototype, + and prefer STRLEN over I32 for the UTF-8 length, which as + a domino effect necessitated changing the prototypes of + scan_bin(), scan_oct(), scan_hex(), and reg_uni(). + The stricter UTF-8 decoding checking uses Markus Kuhn's + UTF-8 Decode Stress Tester from + http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt + + Run vms/vms_yfix.pl, should have done that after changing + perly.c in #7382. + + Subject: [PATCH 5.7.0] static linking with uninstalled perl + + (Replaced by #7440.) + Subject: Re: [ID 20001022.001] Not OK: perl v5.7.0 +DEVEL7368 on i686-linux 2.2.16 + + Fix the bug ID 20001024.005, the bug introduced by #7416. + + Subject: Re: [ID 20001023.003] PATCH perlfaq5 [perl-current] + + Fix the bug reported in + From: andreas.koenig@anima.de (Andreas J. Koenig) + Also make is_utf8_char() stricter. + + Missed the header file changes from #7425. + + Check if stdio supports tweaking lval and cnt simultaneously. + Subject: PATCH (Re: PerlIO - Configure tweak for Linux/glibc?) + + Stratus VOS updates from Paul Green. + + Podify README.epoc and README.vos. + + Add targets to Makefile.SH, most importantly + 'regen_all' which also remembers to update vms/perly*. + + Subject: Minor update to find2perl, for portability + + Subject: patch 7416 breaks sv.c on AIX and HP-UX (patch included) + + Subject: [ID 20001024.007] [PATCH] "Dump local *FH" causes SEGV + + Rename UTF8LEN() to be UNISKIP(), too confusing to have + UTF8LEN() and UTF8SKIP(). + + Allow poking holes at the UTF-8 decoding strictness. + + Continue the internal UTF-8 API tweaking. + Rename utf8_to_uv_chk() back to utf8_to_uv() because it's + used much more than the simpler API, now called utf8_to_uv_simple(). + Still not quite happy with API, too much partial duplication + of functionality. + + A new version of making the syslog test more robust. + (Replaces #7421.) + Subject: Re: [ID 20001022.001] Not OK: perl v5.7.0 +DEVEL7368 on i686-linux 2.2.16 + + buildtoc target tweaks. + + Integrate with vmsperl #7430 by Charles Bailey: + + Cleanup from prior patch (Charles Lane?): + - improve handling of MFDs in Basename and Path + - default to no xsubpp line # munging when building debug images + Branch: maint-5.6/perl + +> vos/config.alpha.def vos/config.alpha.h vos/config.ga.def + +> vos/config.ga.h vos/configure_perl.cm vos/install_perl.cm + !> (integrate 67 files) +____________________________________________________________________________ +[ 8168] By: gsar on 2000/12/18 02:05:49 + Log: integrate changes#7512,7733 from mainline (regex bugfixes) + + Subject: [ID 20001031.004] Uninitialized auto variable in regcomp.c + From: Martin Husemann + + Subject: [PATCH 5.7.0] restore match data on backtracing + From: Ilya Zakharevich + Branch: maint-5.6/perl + !> regcomp.c regexec.c t/op/re_tests +____________________________________________________________________________ +[ 8167] By: gsar on 2000/12/18 01:55:22 + Log: integrate changes#7858,7986 from mainline + + C in pseudo-fork()ed process may diddle + parent's memory; fix it by keeping track of the actual pad + offset rather than a raw pointer (this change is probably also + relevant to non-ithreads case to avoid fallout from reallocs of + the pad array, but is currently only enabled for the ithreads + case in the interests of minimal disruption to existing "well + tested" code) + + fix open(FOO, ">&MYSOCK") failure under Windows 9x (problem is + due to the notorious GetFileType() bug in Windows 9x, which fstat() + tickles) + Branch: maint-5.6/perl + !> embed.h embed.pl global.sym objXSUB.h perlapi.c pp_ctl.c + !> proto.h scope.c scope.h sv.c t/op/fork.t win32/perlhost.h + !> win32/win32.c win32/win32.h win32/win32sck.c +____________________________________________________________________________ +[ 8166] By: gsar on 2000/12/18 01:52:59 + Log: integrate changes#7626,7632,7717,7738,7814,7817,7902,7912,7915 + from mainline (xsubpp and ExtUtils::LibList fixups, various + other small items) + + The generated boot_* headers are wrong. Pickier compiler, + such as KAI C++ will refuse to compile the resulting perlmain. + Subject: [ID 20001109.005] Bug in minimod.pl, perl 5.6.0 + + Various doc oddball characters. + Subject: [ID 20001106.004] Perl 5.6.0 bugs + + Subject: [PATCH] Re: 20001101.003 PDL + + Subject: [PATCH 5.7.0] etags broken again + + Subject: [PATCH 5.7.0] Liblist finally works + + Subject: [PATCH 5.7.0] Liblist returns found libraries + + Subject: [PATCH] Re: 5.6 bug: split /^/ implies /m modifier (from CLPM) + + Subject: [PATCH 5.7.0] OUT keyword for xsubpp + + Subject: Re: [PATCH 5.7.0] OUT keyword for xsubpp + OUT keyword nits. + Subject: Re: [PATCH 5.7.0] OUT keyword for xsubpp + OUT and IN_OUT documentation. + Branch: maint-5.6/perl + !> emacs/cperl-mode.el emacs/ptags lib/ExtUtils/Liblist.pm + !> lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MakeMaker.pm + !> lib/ExtUtils/xsubpp lib/unicode/syllables.txt minimod.pl + !> pod/perlfunc.pod pod/perlxs.pod pod/perlxstut.pod t/op/split.t + !> win32/bin/search.pl +____________________________________________________________________________ +[ 8165] By: gsar on 2000/12/18 01:28:45 + Log: integrate changes#7533,7563,7611,7623 from mainline (various + malloc.c embellishments) + Branch: maint-5.6/perl + !> malloc.c pod/perldiag.pod +____________________________________________________________________________ +[ 8164] By: gsar on 2000/12/18 01:23:33 + Log: integrate changes#7419,7806,8129 from mainline (various h2xs + fixups) + Branch: maint-5.6/perl + !> utils/h2xs.PL +____________________________________________________________________________ +[ 8163] By: gsar on 2000/12/18 01:17:50 + Log: integrate changes#7493,7599,7803 from mainline (various perlbug + fixups) + Branch: maint-5.6/perl + !> Makefile.SH utils/perlbug.PL +____________________________________________________________________________ +[ 8162] By: gsar on 2000/12/18 00:25:43 + Log: always export Perl_deb() (it is required by re.xs whether + Perl is built with or without -DDEBUGGING) + Branch: maint-5.6/perl + ! makedef.pl +____________________________________________________________________________ +[ 8161] By: gsar on 2000/12/18 00:23:38 + Log: integrate change#7414 from mainline + + Undo the basename() part of #7412 since the lib/basename + tests would need upgrading too. + + squelch two tests in tr.t that rely on tr/// paranoia change + that's not in 5.6.x + Branch: maint-5.6/perl + ! t/op/tr.t + !> lib/File/Basename.pm +____________________________________________________________________________ +[ 8160] By: gsar on 2000/12/18 00:05:30 + Log: missing change in previous integrate + Branch: maint-5.6/perl + !> README.aix +____________________________________________________________________________ +[ 8159] By: gsar on 2000/12/18 00:03:38 + Log: integrate changes#7205..7210,7212,7214..7219,7222,7223,7225,7226, + 7228,7230..7241,7243,7346,7347,7350..7354,7356,7358..7360,7362, + 7363,7365..7368,7370..7374,7376..7386,7391,7393..7399,7404..7408, + 7410..7413 from mainline + + Introduce the man[24-8] variables, from Andy Dougherty. + + Upgrade to CPAN 1.58, from Andreas König. + + An updated EBCDIC tr patch. + Subject: Re: [PATCH: perl@7181] op/tr tests on OS/390 + + Subject: [PATCH] 5.6.0 & 5.7.1, VMS fixes + + Two thirds of + Subject: Proposed patches, Install.pm getopts.pl termcap.pl + The Install.pm changes will be submitted separately because + they need some work and discussion still. + + The Install.pm third of + Subject: Proposed patches, Install.pm getopts.pl termcap.pl + + Subject: [PATCH: perl@7181] was: Re: off to a bad start on fixing regression tests + + Subject: [PATCH 5.7.0] IVs in mtats + + Subject: [PATCH 5.7.0] Perl API for mstats + + Ilya implemented the memory profiling API. + + In Amdahl UTS "struct sv" is defined by a system header, + . + + Slight tweak of the code to appease Amdahl UTS cc. + + Amdahl UTS doesn't seem to do dynaloading. + + Use UTF8SKIP(), from Simon Cozens. + + Thinko in #7222. + + op/sprintf.t patch for OS/390 (and any other host with limited + floating-point exponent length) + Subject: Re: [ID 20001006.014] Not OK: perl v5.7.0 +DEVEL7158 on os390 05.00 (UNINSTALLED) [PATCH bleadperl] + + Tweak #7225. + Subject: Re: [ID 20001006.014] Not OK: perl v5.7.0 +DEVEL7158 on os390 05.00 (UNINSTALLED) [PATCH bleadperl] + + Subject: RFC: a (temporary?) way around utf8.pm for EBCDIC + + Needs to be conditional on SunOS 4. + Subject: [Pach 5.7.0@7229] Removing -ldb from the core build + + Test cases for bug id 20000323.056 (the bug seems to be fixed). + + Add test for bug id 20000427.003 (which seems to have + been fixed) (also duplicate as 20000427.004, though + with a higher severity). Move one utf8 from op/append + to pragma/utf8, tag the tests with bug ids. + + Document FNCASE=y as discussed in the bug 20000902.009. + + split() utf8 fixes. Should fix both 20001014.001 and 20000426.003. + The problem was that rx->minlen was in chars while pp_split() + thought it would be in bytes. + + Make ~(chr(a).chr(b)) eq chr(~a).chr(~b) on utf8. + Subject: [PATCH] Re: [ID 20000918.005] ~ on wide chars + + Fix few quad issues, which for example broke chr(~chr(~0)) for UTF8. + + Fix a couple of compiler-noted nits in #7235. + + Tweak the test of #7235. + + One more ~utf8 tweak. + + -w cleanup. + Subject: Re: Problems with bleadperl + + Subject: small pod patch + + Subject: [PATCH perlguts.pod] Document offset hack + + Add Charles Lane. + + Add the capability to include/exclude branches. + + Subject: [ID 20001016.012] [PATCHes Included]OK: perl v5.7.0 on dos-djgpp djgpp + + Detect early whether the std streams have gone bad. + Subject: PATCH (was Re: [ID 20001016.007] Not OK: perl v5.7.0 +DEVEL7228 on i586-linux 2.2.16 (UNINSTALLED)) + + More IoTYPE sprinkling. + + Workaround for a sfio bug where the stream error indicator + is not cleared as documented. + Subject: PATCH (was Re: [ID 20001016.007] Not OK: perl v5.7.0 +DEVEL7228 on i586-linux 2.2.16 (UNINSTALLED)) + + Clarify documentation on 'use bytes'. + Subject: Re: What does 'use bytes' "mean" ? + + Show the failed remote port, instead of the failing line number. + Subject: [PATCH 5.6.1 Debugger] More diagnostics + + Make Cwd more bulletproof in chrooted environments. + Subject: [ID 20001018.001] Fix for Cwd.pm (chroot) + + Subject: Pod patch for Devel::Peek + + Subject: Re: [ID 20001013.008] perl 5.6.0 on AIX 4.3.2 w/GCC 2.95.2 + + Borland C fstat() never saw the fd as writable. + Subject: fix for Borland's weak "stat" (perl@7211) + + Missing change from #7362. + + Subject: [PATCH 5.7.0] Re: [ID 20001018.008] flip-flop bug when there's no + + Add the test case for the bug id 20000730.004 which seems + to have been fixed by now. + + Fix of sorts for bug id 20000901.092. There seems to be no trace + of a 'pmshort' anywhere in the B, so the offending line was simply + removed. + + Subject: Re: [ID 20001013.008] perl 5.6.0 on AIX w/GCC + + Subject: PATCH do_print has 2 PerlIO_error()s + + NonStop-UX patches from Tom Bates + + Typo noted by Mark Lutz. + + Subject: PATCH CR+LF should be "\cM\cJ" in perlop + + In the latest compiler builds cccdlflags must not become -fpic, + from Wilfredo Sánchez. + + Subject: [PATCH] Perl 5.6.0/5.7.0, vms/gen_shrfls.pl update + + Subject: [PATCH] Perl 5.6.0/5.7.0 enable DProf test for VMS + + SOCKS function redefinitions need prototypes, too, otherwise + for example 32 bit versus 64 bit differences cause a lot of + problems. Part of + Subject: [ID 20001016.017] [jens: 5.7.0 Solaris 8, 64 Bit, Workshop 6.0 Compiler] + + Portability tweak on #7377. + Subject: Re: [nick@cow.org.uk: [ID 20001020.004] Not OK: perl v5.7.0 +DEVEL7368 on i386-freebsd-64all 4.1-stable (UNINSTALLED)] + + Don't write double values through long double pointers, + based on a part of + Subject: [ID 20001016.017] [jens: 5.7.0 Solaris 8, 64 Bit, Workshop 6.0 Compiler] + + Reëntrancy fix. + Subject: [PATCH perl@7229] Rentrant parser and yylex() + + Make scan_num() reëntrant, as suggested in + Subject: [PATCH perl@7229] Rentrant parser and yylex() + + Fix for ID 20001020.006, concatenating an unset submatch + with utf8 resulted in "Modification of a read-only value". + + Fix for ID 20000915.011, IO::Select warning for an undefined fd. + + The #7383 was right only in the context of the original bug report, + not in more general case. + + Update Changes. + + Testcases for a #7383,#7385 related bug. + Subject: PATCH Re: [ID 20001020.006] "$2$utf8" == modification of read-only-variable + + Subject: [PATCH@blead Tie/Array.pm] Re: [ID 20001020.002] Tie::Array SPLICE method is buggy + + Tweak the Is* definitions of Unicode character classes + to better match the official categorizations; embrace + the official categorizations; add the combining marks + as alpha (and -numeric); fix DCinital (a typo and edito) + to be DCmedial. + + Hints tweak from Anton Berezin. + + Subject: installman go-faster stripes + Subject: Re: installman go-faster stripes + + Subject: [ID 20001021.003] updated hints/openbsd.sh + + Subject: [PATCH bleadperl] -MO=C falls over on package + + Subject: PATCH $Config::Config{ldlibpthname} in ext/DynaLoader/DynaLoader_pm.PL + + Subject: [PATCH] Re: [ID 20000121.007] XXX documentation in man ExtUtils::MakeMaker + + Doc patch. + Subject: [ID 19991128.002] \&{'foo'} not caught by strict refs + + Retract #7404 with a patch from Robin Barker, via Andy Dougherty. + + Subject: Re: [ID 20001021.005] SEGV with regex match + + Subject: Re: [20000731.007] potential syntax error not detected [PATCH] + + The change #7187 was not so good on VMS. + Subject: [PATCH perl@7369] VMS perldoc.PL fix for double quoted temp filename + + Subject: [PATCH: perl@7386] miscellaneous typos in 3 pods + + Miscellaneous MacOS Classic library updates from Matthias Neeracher. + + Document PERL_INSTALL_ROOT of #7210. + Branch: maint-5.6/perl + +> README.aix hints/nonstopux.sh lib/unicode/Is/DCmedial.pl + +> t/lib/tie-splice.t + - lib/unicode/Is/DCinital.pl + !> (integrate 112 files) +____________________________________________________________________________ +[ 8156] By: gsar on 2000/12/17 22:49:13 + Log: integrate changes#7069..7077,7079,7081..7087,7090,7092,7093, + 7096..7104,7109..7117,7119..7124,7126,7128,7129,7133,7134, + 7136..7139,7141..7146,7148,7149,7151,7153..7155,7157,7158, + 7160,7161,7164,7165,7169..7178,7180..7191,7193..7197,7199, + 7201,7204 from mainline + + Remove vestiges of tr//CU. + Subject: [ID 20000912.009] perlunicode.pod still mentions tr///CU + Subject: Re: [ID 20000912.009] perlunicode.pod still mentions tr///CU + + The return value of setlocale must be copied away. + Subject: [ID 20000913.001] Heap corruption in Perl_init_i18nl10n + + Allow chop() and chomp() to be overridden. + Subject: [PATCH] Re: [ID 20000911.006] I can override glob but not chop? + + Hints optimization. + Subject: Minor nit + + Subject: [PATCH] de-wall t/README + + Subject: Re: Two advertising clauses need to be removed + + Batch of UTF-8 patches from Simon Cozens. + + Fix for a parsing bug, not for the original bug. + Subject: Re: [ID 20000910.005] Another segfault with regexes. + + Compilation warnings and an error. + + Subject: File::Find 5.7.0 POD nits + + Subject: [PATCH perl-5.7.0] continued -Wformat support + + The one that got away. + + Subject: Re: perl@7078 + + UTF8-encoded version of 256 is 0xc4 0x80; test that a char is + convertable to bytes by checking it doesn't go above 0xc3 + Subject: Re: perl@7078 + + Replace #7084 with + Subject: Re: perl@7078 + + We don't need to count the high bit bytes, a boolean is enough. + + Subject: [PATCH] utf8.c apidoc + + Subject: Re: perl@7078 + + Botched the #7090 check-in. + + Fix for the charnames.t failures from Spider Boardman. + + Re-instate Perl_utf8_to_uv without checking parameter - added in change 7075. + i.e. rename Simon's function to Perl_utf8_to_uv_chk, change all calls to it + to use new name and add Perl_utf8_to_uv() as a wrapper which calls it passing + 0 to checking to get the warning. + + Subject: [PATCH] Nits in perlmod.pod + + Subject: Re: Trapping by opmask sets strange parser state [PATCH] + + Subject: Re: unicode support and perl [ID 20000901.097] + + Subject: Re: unicode support and perl [ID 20000901.097] + + Subject: [PATCH perl@7065] another VMS my_fwrite() fix for Storable + + Subject: [PATCH] Re: [ID 20000915.010] Infinite loop with -MO=Deparse + + Subject: [ID 20000917.002] 5.7.0 and blead@7095 make html makes man + + Subject: [PATCH@blead] Fix some recursion in overload.pm + + s/Robin Parker/Robin Barker/ + + Subject: [PATCH] Fix aliasing of tied filehandles + + Subject: Re: [ID 20000912.008] substr replacement of tainted data (bug) + + Subject: Re: [PATCH 5.005_64 missed] + + SOCK_DGRAM and listen() do not mix as reported in + Subject: [ID 20000930.001] Bug in perl 5.00503 IO::Socket + The patch for 5.7.0+ had to be reengineered, though. + + Subject: DOC PATCH 5.6.0 + + Subject: [PATCH 5.7.0] Minor optimization in re_intuit_start + + Document the issue (is not a syntax error, kind of) + Subject: Re: [ID 20000901.011] the list (1,,3) ought to be a syntax error + + Subject: [ID 20000928.002] perlcc & ByteCode.pm option mismatch + Did not apply cleanly, manual intervention was needed. + + Subject: [PATCH] DLL not restartabke with threaded perl + + Inside require() $^S was always left undefined. + Subject: Re: Tiny 2-byte change to fix debugger's eval bug + + Subject: [PATCH pod/perlop.pod] Documentation glitch in magic autoincrement. + + OpenBSD flags tweak from Todd C. Miller, tweaked some more by Abigail. + + Regen headers. + + Subject: [PATCH 5.7.0] Epoc update + + Introduce NO_ENVIRON_ARRAY (and USE_ENVIRON_ARRAY) defines + as suggested by Olaf Flebbe and Nick Clark. + + Subject: [ID 20000915.007] Not OK: perl v5.7.0 +DEVEL7092 on os2-64int-ld 2.30 '(UNINSTALLED)' + + Misplaced else. + + Scale down the VMS message boxes, by Charles Lane. + Fix for ID 20000903.009, workaround at + http://www.xray.mpe.mpg.de/mailing-lists/vmsperl/2000-09/msg00039.html + + Subject: [ID 20001003.006] B::Debug not -w clean + + Test harness update to sync with the new perlcc, + from Simon Cozens. + + One remaining nit less at the VMS mailbox sizing. + + Subject: [PATCH: 7131] PWPASSWD problem for passwd less pwd's + + It is possible to have no hosts database at all. Pointed out in + Subject: [PATCH: 7131] PWPASSWD problem for passwd less pwd's + + Subject: [PATCH 5.7.0] h2xs not working + Subject: [PATCH 5.7.0] h2xs not documenting the created module + + Subject: [PATCH] 5.6.0 & 5.7.0 VMS TZ fix for VMS6.2 and earlier + + Subject: perlhack.pod Patch for Externals Tools + + Subject: [PATCH perlrun.pod] Re: [ID 20000930.002] perlrun nor perldelta mention -s modification + + Subject: Re: [PATCH 5.7.0] h2xs not documenting the created module + + Enable disabling scripts installation by Configure -Uinstallscripts, + suggested by H. Merijn Brand. + + Code around the stat-on-a-pipe-returns-a-mode-of-zero bug + reported several times by Dominic Dunlop, for example in + ID 20000315.008. Patch from Dominic. Patch affects at + least MachTen, and possibly other oldish BSDs. Should not + break non-broken platforms (tested on LinuxPPC). + + Regen toc. + + Subject: Re: Questions about Tie::Array and perl modules + Bug reported and fix suggested by Philip D Crow . + + Patch from Simon Cozens to avoid using utf8 routines in EBCDIC. + + Tweak #7153. + + IO::Handle->syswrite() did not handle length omission + like CORE::syswrite() does. + Subject: [Fwd] IO::Handle, syswrite and arguments + The original patch from andrew@ugh.net.au. + + Also the $ccflags is needed for the C compiler check. + Subject: Configure (check for C-compiler) + + Eliminate $Is_VMS code from the test. + Subject: Re: [ID 20001004.005] Not OK: perl v5.7.0 +DEVEL7129 on VMS_AXP V7.1 + + Fix bug in #7157 (s/cflags/ccflags); moved the -o foo + as the first option of cc/ld because of ultrapicky compilers + (e.g. OS/390 R2.5) + + Change the version number of Tie::Handle in the core to 4.0, + the (unrelated) Tie::Handle in CPAN will remain at 3.0. + Subject: Note on Tie::Handle + + UTF8ize split() so that the cloned substrings get the UTF8 + flag of the original scalar. Problem reported by Simon Cozens. + + save_re_context() could reset PL_curcop to freed memory, causing core + dumps in code such as C + + Subject: PATCH 5.6 perldebguts grammar cleanup + + Add a todo note about overloadable assertions. + + on Windows, LoadLibrary() could load an extension DLL multiple + times if forward slashes are used in the path + + on Windows, cwd strings in the environment should be of the + form =X:=X:\foo instead of =X=X:\foo\ + + on Windows, avoid potential exception (could happen if MSVCRT isn't + being used) when closing a socket handle + + avoid nonportable example code + + Windows9x doesn't support link(), despite what Config.pm + might think + + pod nit + + Change #7160 had a nasty typo. + + Warn about unknown scripts. + Subject: Re: ideas? patches? [PATCH bleadperl] + + on Windows, clean targets might not work under some flavors of the shell + + tweak for change#7173 + + Make eq work again with utf8 (disabling the upgrading + should no more be necessary since the copies of the + scalars are upgraded, not the scalars themselves). + Takes care of ID 20001009.001. (The claimed length() + bug in 20001009.001 seems bogus to me.) + + Subject: [PATCH: perl@7159] various VMS cleanup issues + CXX configure + + Upgrade to CGI.pm 2.74, from Lincoln Stein. + + Upgrade to podlators 1.04, from Russ Allbery. + + Subject: [PATCH 5.6.0] Re: [ID 20001009.004] SEGV from sprintf in a thread + + Quote the temp file name, needed in Win32 because the + default name unfortunately contains spaces, shouldn't + hurt elsewhere. + Subject: FW: perldoc fails if $TEMP contains spaces + + Subject: RE: [ID 19990803.001] README.win32 suggestions + + Subject: [ID 20000720.004] ExtUtils::MakeMaker finds wrong version of perl + + Subject: Re: utf8 concat, mg_get + + Subject: [PATCH: perl@7181] perlebcdic.pod updates and corrections + + Subject: [PATCH: perl@7181] op/tr tests on OS/390 + + Subject: [PATCH: perl@7181] ver.t v string tests for os/390 + + Use the versiononly instead of the installscripts, + retract the changes 7146 and 7147. + + Reapply Andy's patch and regen Configure. + + Add the test case for #7190, from the original bug report + by Andreas König. + + Remove duplicated code. + + SvPV() (via mg_get() of sv_2pv()) can update the UTF8ness of the SVs. + + restore change#7202 + Branch: maint-5.6/perl + !> (integrate 121 files) +____________________________________________________________________________ +[ 8153] By: gsar on 2000/12/17 21:23:05 + Log: integrate changes#7017..7019,7021..7025,7027..7036,7038,7039, + 7041..7044,7046..7048,7050..7061,7063,7066..7067,7069..7074 + from mainline + + Document the SvIOK_.*UV(). + + Update Unicode todo list. + + Guard against bad string->int conversion for quads. + + Subject: small apidoc fix + + Subject: [PATCH] Tie::StdHandle did not know about 3-arg open + + Subject: [PATCH] Tied filehandle documentation + + Subject: [PATCH] Modernize Opcode.pm documentation + + Make Data::Dumper (non-XS) to work with changed semantics of ref(). + Subject: Re: Undocumented(?) change to "ref" semantics in 5.7.0 + [applied even though said semantics didn't change in 5.6.x] + + Subject: [PATCH@7014] \G in non-/g is well-defined now ... right? + + Subject: Re: [ID 20000905.001] Assertion failed: file "toke.c", line 202 + + Fix the URL, but the server is still missing in action. + Subject: [ID 20000905.002] perlfaq1.pod URL error + + Subject: [ID 20000903.001] \w in utf8-strings + + Fix the ccversion detection for 5.1 and beyond. + Subject: [ID 20000907.007] Not OK: perl v5.7.0 +devel-7030 on alpha-dec_osf 4.0f + + Subject: [PATCH 5.7.0] perl5db.pl [Was: Re: Debugger question] + + Subject: [ID 20000904.008] Tiny fix for perldiag + + Subject: Re: [ID 20000906.004] segfault with bad perl statement + + Subject: Re: [ID 20000907.007] Not OK: perl v5.7.0 +devel-7030 on alpha-dec_osf 4.0f + + Subject: [ID 20000908.002] perlipc documentation bug. + + Subject: [PATCH lib/Benchmark.pm] + + Re-allow vec() for characters > 255. + Subject: [PATCH] Re: [ID 20000907.005] Not OK: perl v5.7.0 +devel-7030 on alpha-dec_osf-perlio 4.0f (UNINSTALLED) + + Do away with memory models cruft. Sorry, PDP users. + + Continue #7041. + + Subject: [PATCH (or RFC): 5.7.0] make the ran_tests intermediate file 8.3 friendly + + Subject: [PATCH: 5.7.0] proper setting for isnan for DECC 5.3 + + Upgrade to CPAN 1.57_65, from Andreas König. + + Upgrade to podlators-1.03 (Pod::Man 1.07 and Pod::Text 2.05), + by Russ Allbery. + + Silence t/pod/*.t about alternate quote-mappings now implemented + by Pod::Text, from Brad Appleton. + + Modern Borland C now seems to have anon unions for info.wProcessorArchitecture + Subject: borland C++ win32.c tweak + + C<@a = @b = split(...)> optimization coredumps under ithreads + (missed a spot when fixing up op_pmreplroot hack for ithreads) + + Document the SvUTF8*(). + + Subject: [PATCH] Perl 5.6.0, 5.7.0 ... vms/test.com to eliminate spurious NL's in test output + + Subject: RE: [Patch 5.7.0] Removing -ldb from the core build + + Do in VMS as the #7054 does. + + Subject: [patch] perlfunc.pod -- POSIX::sigpause should be POSIX::pause + + Subject: [ID 20000911.008] Not OK: perl v5.7.0 +DEVEL7048 on os2-64int-ld 2.30 (UNINSTALLED) + + Subject: [patch: perl@7045] vms updates + + Test for the #7049. + Subject: Re: [PATCH] Re: [ID 20000910.001] Not OK: perl v5.7.0 +DEVEL7044 on i686-linux 2.2.16-raid (UNINSTALLED) + + Break up the myconfig lines a bit. + Subject: perlbug/perl -V output format + + Subject: [ID 20000911.011] misplaced typemap in perlxs.pod + + The #7054 truncated Configure badly. + + change#6327 didn't quite go all the way to enable USE_SOCKETS_AS_HANDLES + initialization in all the threads on Windows + + Allow for whitespace between "#" and "line" in cpp output. + Subject: [PATCH] Re: Problems compiling bleadperl on Unicos 9 + + Remove vestiges of tr//CU. + Subject: [ID 20000912.009] perlunicode.pod still mentions tr///CU + + The return value of setlocale must be copied away. + Subject: [ID 20000913.001] Heap corruption in Perl_init_i18nl10n + + Allow chop() and chomp() to be overridden. + Subject: [PATCH] Re: [ID 20000911.006] I can override glob but not chop? + + Hints optimization. + Subject: Minor nit + + Subject: [PATCH] de-wall t/README + + Subject: Re: Two advertising clauses need to be removed + Branch: maint-5.6/perl + !> (integrate 75 files) +____________________________________________________________________________ +[ 8152] By: gsar on 2000/12/17 20:30:11 + Log: integrate changes#6945,6947,6949..6954,6956,6958,6959,6961, + 6964..6972,6977..6981..6984,6987,6988,6991,6994,6997, + 6999..7001,7003..7005,7007,7009,7011,7012 from mainline + + Don't attach -ld to the archname if pointless. + + Document UNTIE in a very minimalistic way. + + POSIX doesn't report long double values under -Duselongdouble + when the long doubles are "real" (bigger than doubles). + + More author updates. + + Try to deduce NV_MAX. Really should be Configure fodder. + + :: not allowed in pathnames, change to . + Subject: [PATCH perl@6938] cygwin port + + Forget about NV_MAX (#6951). Various floating point tweaks, + ideas from Eric Fifer, Yitzchak, Alan, and Spider. + + Move the Solaris 7 scan to use64bitall, make the + failure to find 64-bot sparc libc to mention the + possibility of being in an intel, from Lupe and Alan. + + Regen perltoc. + + AUTHORS tweaks, from Peter Prymmer. + + More address tweaking. + + Small tweaks all over. + + File::Temp patches from Andreas König, + + Subject: [PATCH perl@6962] 2 more vms.c fix-ups and status + + Subject: CPAN.pm beta 1.57_57 for the core + + Part of the solution. + Subject: Re: [ID 20000807.004] [PATCH] conditional breakpoints leak memory + + Subject: [PATCH@6961] Fix misleading example in perlretut.pod + + Subject: [PATCH lib/overload.pm] Sanaty checking of arguments to overload::constant + + Add the overload warnings to perldiag. + + Drop unused argument. + Subject: Re: [ID 20000831.034] overload::constant and number of arguments. + + Subject: Nit in Configure (bleadperl@6961) + + Update to PodParser 1.18, from Brad Appleton. + + Subject: [ID 20000901.017] [PATCH] Basic test failure in an untidy world + + Subject: [PATCH: 6948] add SCNfldbl to configure.com + + Document UNTIE. Also tweak implementation to suppress the 'inner references' + warning when UNTIE exists and instead pass the cound of extra references to + the UNTIE method. + + Rename the PRIElfbl, PRIX64, etc, to be PRIEUfldbl, PRIXU64, + so that case-ignoring systems like DCL can tell them from + PRIefldbl and PRIx64. Apply Merijn's ccversion patches. + + Subject: Re: [PATCH lib/overload.pm] Sanaty checking of arguments to overload::constant + + Feature ordering tweak. + + Regen perltoc. + + Subject: [PATCH] Fix vec() / utf8 (was Re: bitvec ops still broken with utf8 -- or not?) + + Subject: Re: [PATCH perl@6962] 2 more vms.c fix-ups and status + + Subject: http:// in L<> + + Detypo. + + change#6791 accidentally clobbered change#6710, put it back + + Only the first line, thank you very much. + + Subject: [PATCH: 6996] minimal removal of 8 bit chrs from perlebcdic.pod + plus rework the http: spots as suggested by Tom Christiansen, + plus regen perltoc. + + Undo part of change 6489 which looks like a bulk edit which + changed _all_ gv_efullname3() calls to gv_efullname4() calls. + The supressing of main:: on return from select() is undesirable. + + Apparently avoiding the swapping is too costly. + + Various Configure nits by Philip Newton, + plus the ebcdic one by me. + + Make certain cc is set before trying to run it. + + If overloaded %{} etc. return the object do not loop. + Thus sub deref { $_[0] } functions if object is wanted type. + + Update perlhist. + + More %{} and other deref special casing - do not pass to 'nomethod'. + Branch: maint-5.6/perl + !> (integrate 59 files) +____________________________________________________________________________ +[ 8151] By: gsar on 2000/12/17 19:14:38 + Log: integrate changes#6903,6905..6907,6909,6911..6913,6915,6917,6918, + 6920..6926,6928..6930,6934..6937,6939,6940,6942..6944 from mainline + + Subject: [PATCH perl@6889] Chuck Lane's OpenVMS piping improvements + + Make the epsilon to be relative, not absolute. + + Put back the flags dump as reasoned in + Subject: Re: [PATCH] Glob dumping + + Introduce ccname to keep track of what compiler kind of we have. + + Subject: Re: [ID 20000829.020] perl -e 'package; print __PACKAGE__' core dumps + + Put back the slice accidentally removed by #6907. + + Reset archname and archname64 always, forcing them be + recomputed at each Configure run, make Configure and + the hints files agree on the naming of largefiles variables. + + Don't say "Perl 5.0 source kit". + + Subject: [PATCH] fix misc cast warnings + + Subject: typos in pods + + NVs not necessarily doubles, as pointed out by Yitzchak. + + Subject: [PATCH 6889] add a few ldbl formats to configure.com + + Subject: [ID 20000830.036] [DOC] chom?p %hash not documented + + Better options for rsync. + + Subject: [PATCH perl@6889] fix Storable on VMS by fixing my_fwrite() + + Subject: Re: not OK, 6919 on Alpha VMS V 7.1 w/ DECC 6.0-001 + + Subject: [PATCH] Re: UNTIE method + + A better fix for the Socket building problem from Craig Berry. + + Retract the dummy test, skip the security tests (instead of failing), + explain what the warnings mean. + + Heap decorruption. + Subject: [PATCH] Fix for miniperl coredump on Solaris with -Duselongdouble + + Update to Unicode 3.0.1. + + Missed one Unicode file. + + Subject: Re: typos in pods + + The #6929 was too skimpy. + + sscanf() may be the only way to read long doubles from strings. + + Reveal Borland's isnan. + Subject: build with BC++ tweak + + Issue useful diagnostic on unknown pod commands. + Subject: [PATCH lib/Pod/Man.pm] Re: [ID 20000830.048] + + Subject: [PATCH] Re: [ID 20000830.048] Not OK: perl v5.7.0 +DEVEL6938 on i686-linux 2.2.13 + + Clarify the third case of ftmp-security warnings. + + Make -Dusemorebits find long doubles in Solaris. + + Wrap the test in eval. + Branch: maint-5.6/perl + +> lib/unicode/BidiMirr.txt lib/unicode/CaseFold.txt + +> lib/unicode/PropList.txt lib/unicode/README.perl + +> lib/unicode/UCD301.html lib/unicode/UCDFF301.html + +> lib/unicode/Unicode.301 vms/vmspipe.com + - lib/unicode/Props.txt lib/unicode/UCD300.html + - lib/unicode/Unicode.300 lib/unicode/Unicode3.html + !> (integrate 305 files) +____________________________________________________________________________ +[ 8146] By: gsar on 2000/12/17 18:09:08 + Log: update Changes + Branch: maint-5.6/perl + ! Changes +____________________________________________________________________________ +[ 7899] By: gsar on 2000/11/28 06:32:55 + Log: reintegrate files missed by change#7895 + Branch: maint-5.6/perl + +> ext/ByteLoader/bytecode.h utils/Makefile + - utils/perlbc.PL +____________________________________________________________________________ +[ 7897] By: gsar on 2000/11/27 18:22:47 + Log: can't integrate these two files, for some reason + Branch: maint-5.6/perl + - ext/ByteLoader/bytecode.h utils/Makefile +____________________________________________________________________________ +[ 7895] By: gsar on 2000/11/27 18:11:21 + Log: integrate changes#6763..6766,6770,6773,6775..6776,6778,6780, + 6782..6791,6793..6814,6816,6818..6822,6824..6830,6838..6849, + 6757..6890,6892..6901 from mainline + + Bytecompiler patches from Benjamin Stuhl. + + More bytecompiler. + + Subject: [PATCH blead] B:: missing dependency + + Subject: [PATCH: 6757] configure.com updates and syslog build + + Long double Gconvert fixes from Yitzchak Scott-Thoennes + and Spider Boardman. + + Subject: [PATCH blead] nextchar() abuse misses an optimisation + + Long double fixes from Spider Boardman. + + Make the selection of NVff et al stricter. + + cSVOPo_*v things index into the current PL_curpad + under ithreads, which is different from the curpad + used by the XSUB. (In other words, the code as-is + before this patch wouldn't work under ithreads.) + + Be portable. + + VMS MMS (make) wants null action. + + Mac and other portability updates from Chris Nandor. + + Storable support, v-version fixes. + Subject: CPAN.pm beta for testing available + + Portability fix from Hugo van der Sanden. + + Bad makefile. + + Subject: [ID 20000823.004] [PATCH 5.6.0+] Pod::Html is too self-contained + + Subject: [PATCH] (Mac OS X): Don't #define environ unless PERL_CORE + + Subject: [PATCH] Re: [ID 20000821.008] Negitive numbers with vec dumps core + + Replace #6705 with a minimal doc patch. + Subject: [PATCH 5.6.0] replace change #6705 + + Drop the separate perlbc, perlcc -b should be enough. + + installperl couldn't tell whether it had run tests or not. + Subject: [PATCH] Re: installperl and t/TEST + + Add silencer flags to installperl. + Subject: [PATCH] Making installperl silent. + + Make "make install" by default silent. A new "install-verbose" + target is verbose. + + More liberal parsing of version numbers. + Subject: Re: CPAN.pm beta for testing available + + Create directories in silence. + Subject: [PATCH] Another silencer for MakeMaker + + DOS patches and portability/porting notes, from Tim Jenness. + + Make installman to recognize the silence flag -S. + + Actually do something with the silencer option. + + Continue silencing. + + Show the doc file, not the temp file. + + Regen perltoc. + + Subject: [PATCH] More silencing of installman. + + Better wording for the vec lvalue diagnostic. + Subject: Re: [PATCH] Re: [ID 20000821.008] Negitive numbers with vec dumps core + + Subject: [PATCH: 6805] several more tweaks to configure.com + + Subject: [PATCH perl@6805, 5.6.0, 5.005_03] prevent rare Perl hang on VMS + + Missing parts of + Subject: [PATCH: 6789] some endl fixes for VMS wackiness + + Subject: [ID 20000824.029] MakeMaker manifypods fails on DJGPP systems + (applied slightly modified) + + installperl --verbose and --silent. + Subject: Re: [PATCH] More silencing of installman. + + Add install-silent target. + + AIX 4.3.3 has SOCKS in libc with a differently named init routine, + the problem reported in + Subject: [ID 20000825.007] Building stable 5.6.0 on AIX 4.3.3 using SOCKS + + Tweak the sfio/useperlio logic, hopefully as wished in + Subject: [ID 20000825.004] Not OK: perl v5.7.0 +SUIDMAIL +DEVEL6804 on i586-linux 2.2.12 (UNINSTALLED) + + One forgotten file from #6816. + + Subject: [PATCH @6820] installman under -w and strict (was Re: [PATCH] More silencing of installman.) + + Remove duplicately applied patch shards. + Subject: [ID 20000825.012] [PATCH@6822] t/lib/cgi-html.t produces ugly cruft during 'make test' + + Support preserving extremely big/small angles. + + Subject: Re: [ID 20000825.019] Not OK: perl v5.7.0 +SUIDMAIL +DEVEL6820 on alpha-dec_osf 5.1 (UNINSTALLED) + + Subject: [PATCH] installation not quite silent yet. + + Update the test count. + + Use UVxf, PTR2UV, NVff. + + Document PTR2XX and INT2PTR. + + no-install target a la make -n. + Subject: [PATCH] make no-install (was Re: [PATCH] installation not quite silent yet.) + + grep -e isn't portable. + Subject: [ID 20000825.027] let me (perlbug@perl.com) know how I blew it + + Can't get the test to reliably work thanks to the + inaccurateness of floating point. "Resolves" bug ids + 20000826.003, 20000826.009, 20000826.010, + + Subject: installman buglet + + DJGPP update from Laszlo Molnar. + + Subject: MM_Unix.pm LD_RUN_PATH niggles on Solaris + + Passing -R in ldflags makes now it to appear in the default + for lddlflags, just like with -L. + Subject: Re: MM_Unix.pm LD_RUN_PATH niggles on Solaris + + Test nit. + + Use the actual thread type, not the pointer-to-struct. + + Provice virtual $Config{ccflags_nolargefiles} etc. + + display_format used as a class method without arguments was broken, + reported in + Subject: Math::Complex->display_format() sets style to 'Math::Complex' + + Subject: [ID 20000828.006] dir name "0" not safe with Cwd.pm + + Subject: [ID 20000828.009] Not OK: perl v5.7.0 +SUIDMAIL +DEVEL6855 on i586-linux 2.2.12 (UNINSTALLED) + + Subject: [PATCH@6855] _Minor_ change to overload.pm pod + + opmini.o may be left around if a build is interrupted. + + Typo in #6858. + + Fix for ID 20000828.001, long doubles were not formatted + correctly (showed up in $], which stopped installing perl). + + An attempt to fix the problem reported in + Subject: Building perl@6856 using gcc/AIX 4.3.3 + I can't test this properly since the gcc installation I have + access to seems to be botched (gcc is calling the AIX cpp, + a losing proposition...) + + Add -ld to archname on long tr...double platforms. + + Subject: hv.h Doc Patch + + Potential cruft. + + Subject: [PATCH bleedperl@6856] warnings fixes + + -S is the silent flag, -s is the strip flag. + Subject: [PATCH] Re: [PATCH] make no-install + + Take out the SUIDMAIL thing, that will not be + a problem in 5.7.*. + + Subject: [PATCH bleedperl@6866] spellings + + Subject: [PATCH] Re: files not cleaned even by veryclean + + Use minimal @INC in tests, most of the time just '../lib', + so that we simply can't pick up stuff from other Perls than + the one we are testing. Pointed out by + Subject: Re: [PATCH: 6757] make new Storable tests forgiving of places where not built + + Update to Getopt::Long 2.24, from Johan Vromans. + + Fix for thinko in #6848. + Subject: Compiler error in ext/Thread/Thread.c (bleadperl@6866) + + Patches all over for people and the files they (hopefully) care about. + + Subject: Net::protoent does not export 'getproto' + + Missed a change in #6869. + + Subject: [PATCH] Warnings in B::Deparse + + Subject: [PATCH] Glob dumping + + Disable one of the tests for now. + + Disabling the one test is a bit tricky. + + Don't forget to tidy up. + + The #6881 removed one dump line. + + Subject: Re: [ID 20000525.003] perldoc fails when Makefile.PL is in cwd + + Under usethreads the dumped variable is IN_PAD. + Subject: Re: [PATCH] Glob dumping + + Subject: [ID 20000829.026] [PATCH 6868] File::Temp + + Subject: [ID 20000829.022] [PATCH 6868] Minor nit in installhtml + + Subject: [ID 20000829.023] [PATCH 6868] perlbug@perl.com --> perlbug@perl.org + + Regen Configure for #6894. + + Subject: [PATCH: 6889] updates to perlebcdic.pod + + Undo namespace pollution of #6878. + Subject: Re: Net::protoent does not export 'getproto' + + Admit that we are leaking scalars. + + Subject: [PATCH 5.6.0] [ID 20000608.006] panic: magic_killbackrefs with blessed global weakrefs + Branch: maint-5.6/perl + !> (integrate 271 files) +____________________________________________________________________________ +[ 7894] By: gsar on 2000/11/27 16:00:34 + Log: a couple of nits + Branch: maint-5.6/perl + ! MANIFEST pp_sys.c +____________________________________________________________________________ +[ 7893] By: gsar on 2000/11/27 15:10:56 + Log: integrate changes#6666..6678,6680..6682,6684..6691,6699..6733, + 6740..6745,6747..6757,6760 + + Subject: Re: [ID 20000816.006] [PATCH @6655] Shell.pm, bug fix, strict and OO Interface + + Subject: [PATCH(2) @6655] Re: perldebut.pod - spelling + + Doc nits spotted by Richard Soderberg. + + move WNOHANG definition to where other such things are + + Make $Config{byteorder} more magical so that it is + dynamically computed: nice for 'fat binaries'. + Subject: [PATCH]: default byteorder + + Subject: [PATCH] Cwd.pm now uses strict + + Subject: Re: [PATCH]Re: Questions about Math::BigFloat + + Get -DLEAKTEST to compile (not necessarily to work, mind) + Subject: [ID 20000724.006] -DLEAKTEST problem + + perldebtut 1.10 from Richard Foley, plus Celsius and Fahrenheit. + + Add perlebcdic from Peter Prymmer, regen toc. + + Don't propose using modules built for 5.005 if no binary + compatibility with 5.005 is attempted. + + Do not use prototyping here. + Subject: [ID 20000817.016] [PATCH] Peek.xs + + Document what the backtick returns if the command fails. + + Add byteorder to the myconfig output. + + Introduce NVef, NVff, and NVgf, use the middle one. + (helps for lib/peek + Linux + long doubles) Reported in + Subject: [ID 20000814.005] Not OK: perl v5.6.0 on i686-linux-64int 2.2.13 + Use NVs in POSIX math, not doubles. + Subject: [ID 20000817.014] POSIX & modfl + + Subject: [PATCH 5.6.0+] newSVrv() memory leak + + The byteorder code in #6671 was wrong. + + Fix the lib/complex failure of + Subject: [ID 20000814.005] Not OK: perl v5.6.0 on i686-linux-64int 2.2.13 + Linux long double accuracy issue: something that + when printed with %g looks like "2" but int() of it is 1. + + Propagate new Configure vars. + + Unbuffer the output. + + Subject: [PATCH] perltrap.pod spring cleaning + + Subject: [PATCH] perlfunc.pod -- clarifying sprintf array argument issues + Subject: [ID 20000817.018] behaviour change 5.5.3 -> 5.6.0 re "Modification of a read-only value" + + Tiny Getopt::Long patch from Johan Vromans. + + Document code point which makes if (defined %stash::) to work + (noted by Spider Boardman). + + Subject: [PATCH perl@6698] cygwin port + + Document the NDBM_File and ODBM_File as SDBM_File + was documented in #6417. + + The new tests were missing from #6415. + + Add [[:blank:]] as suggested in + Subject: [ID 20000716.024] [=cc=] / [:blank:] + (the [=cc=] has already been taken care of by #6439 + so the whole bug report can be closed) + and make [[:space:]] to be equivalent to isspace(3) + (as opposed to \s, which is isSPACE()). The difference + is that now [[:space:]] matches the mythical vertical tab, + while \s doesn't. + + Don't eat leading os from index entries. + Subject: Re: [ID 20000810.006] Pod::Man Ate My 'O'! + + Subject: [PATCH 5.6.0+] fix for Win32::DomainName + + Typo in pp_complement(). + Subject: [PATCH perl-current] Deparse + + Add warnif(), check warnings further up the stack, + all the warnings functions now can take an optional object reference. + Subject: [PATCH bleedperl@6691] warnings pragma update + + Fix a core dump in lib/selfloader under -DDEBUGGING. + Subject: PATCH @6698 for [ID 20000817.007] Not OK: perl v5.7.0 +SUIDMAIL +DEVEL6676 on alpha-dec_osf 4.0f (UNINSTALLED) + + Subject: [PATCH 5.6.0+] fix for Win32::GetFullPathName and Win32::GetShortPathName + + Subject: [PATCH: 6698] tidy up the temp files left by peek tests on VMS + + Subject: [PATCH: 6698] was Re: [PATCH: 6640] VMS Makefile.SH update (fwd) + Put back the long double avoidance code to POSIX.xs + because VMS seems to need it still. + + Introduce a 'veryclean' target that is like 'distclean' + but also removes *~ and *.orig. + + Subject: [ID 20000817.023] endianness description in perlfunc.pod + + Subject: [PATCH perl@6698] File::Temp fix-ups for OpenVMS + + Let's try #6717 again. + + UTF8 concat fixes. + Subject: [PATCH @6713] Re: [ID 20000815.006] latest patched perl core dumps + + pp_open() could pass an uninitialized filename down to do_open9(). + + Subject: Re: [ID 20000819.002] Not OK: perl v5.7.0 +SUIDMAIL +DEVEL6707 on i686-linux 2.2.5-16 (UNINSTALLED) + + Update to CGI 2.72, from Lincoln Stein. + + Subject: [PATCH] Silence MakeMaker (Was: installman) + + Use temporary directory instead of current directory. + Subject: Re: [ID 20000816.011] Test failure in lib/ftmp-security.t + + Document odd vs even subreleases and -Dusedevel. + + The veryclean target needs to clobber. + + Use File::Spec->tmpdir(). + + Document the number of exponent digits. + + Mention perlebcdic and perlposix-bc. + + s/this one/the 5.6.0 release/ + + The #6724 is here. + + The correct cleaning order is an art. + + small tweaks for change#6705: avoid C++ style comments in C code; + use Perl's malloc API rather than the low level system one + + Array context keeps slithering in. + + Subject: Re: 5.7.0 getting really close, new snapshot: perldelta, Storable + + Subject: [PATCH] os2.c fix for use64bitint + + Update to Pod::LaTeX 0.53. + Subject: [PATCH] lib/Pod/LaTeX.pm updates + + Document the endianness of Alpha more precisely. + + Subject: RE: [PATCH perl@6736] t/pragma/warn/9enabled assumes stdout buffered + + Rename the macro argument because some preprocessors + can't tell the difference and expand arguments also inside + double quoted strings. + + free TLS slot properly on Windows + + use Cwd 'chdir' didn't set $ENV{PWD} correctly on Windows + + Unicos/mk requires elaborate paranoia. + + Tweak the floating point output routine preferences. + + Also under djgpp the timestamps are funky. + + Apply some PodParser 1.18 patches; the Pod/Find.pm + patches cannot be applied since #6712 conflicts. + + Use PodParser 1.18 new test. + + A pod nit. + Subject: [PATCH] pod/perlre.pod (was Re: [ID 20000821.007] $&, $1, etc. disappear when sub returns) + + Be verydeepclean. + Branch: maint-5.6/perl + +> pod/perlebcdic.pod + !> (integrate 106 files) +____________________________________________________________________________ +[ 7887] By: gsar on 2000/11/27 14:13:05 + Log: integrate changes#6613..6616,6620..6665 from mainline + + VMS configure.com update continues. + + Subject: Test fails / warnings with perl-current #6612 + + Subject: [PATCH] @+, @- readonly (was Re: @ interpolating in "") + + Subject: Re: [ID 20000807.003] [PATCH] Debugger treatment of condition "0" + + For now remove the mail code. + + Subject: Re: [PATCH] @+, @- readonly + + Subject: warning: storage class after type is obsolescent + + Subject: sfio2000 + + Subject: Re: File::Temp problems on VMS in bleedperl + + README.os2 update. + Subject: Re: [PATCH perl-current] Make op/sprintf.t more comprehensive, + + Make the user to give up his firstborn, err, to knowingly + verify installing an unstable developer release. Also bump + the release to 5.7.0, but leave a patch tag in the local + patches saying that this is not yet the real thing. + + Update (kinda) to Test 1.14, from Joshua Pritikin. + + make ok etc also for win32. + + Subject: [ID 20000815.005] [PATCH] perldoc not looking in the right place for script pod + + Don't blow limited stacks, a lower number is enough to + tickle the lookbehind limit. + + Use -Dusedevel; regen Configure and the respective Porting stuff. + + Subject: [PATCH] debugger exit code should reflect user exit code + + Subject: [PATCH perl@6620] cygwin port + + Missed a file from #6638. + + Subject: [PATCH] for t/lib/peek.t (was Re: [ID 20000814.005] Not OK: perl v5.6.0 on i686-linux-64int 2.2.13) + + magic callbacks all need to have same type signature + + Subject: [ID 20000815.014] [PATCH] INSTALL doesn't mention 64 bit support. + + Fix a dependency problem. + Subject: [PATCH: 6640] VMS Makefile.SH update + + The numeric locale was reset to "C" by s?printf and never restored. + Subject: [ID 20000809.003] setlocale(LC_NUMERIC...) produces different results in 5.005 and 5.6 + No test since adding the failing example to locale.t + does not fail -- probably because the locale settings are so + thoroughly tweaked by that time. Running the example standalone + does fail, though. UPDATE: test case added at change #7540. + + Subject: [ID 20000324.040] minor fix to perlhpux.pod + + Update to CPAN 1.57. + + Subject: [PATCH] Cwd::_backtick_pwd does not check return value + + Change the perlbug address to perl.org since it's more forgiving. + + Change the regx compilation error markers to use = instead of < + since pod makes using the latter quite messy. Reported in + ID 20000814.006 by Abigail and in + Subject: Unknown escape E<> ? + + Update to perldebtut 1.9, from Richard Foley. + + check that the number pseudo children doesn't exceed + MAXIMUM_WAIT_OBJECTS, which is currently 64 (avoids overflowing + the WaitForMultipleObjects() limit that would cause wait() + to crash) + wait() and waitpid() could potentially be rewritten to use + more than one thread to do the waiting to eliminate this + limitation + + change#6328 could make close(SOCKET) return false on windows + when it shouldn't + + pod nit seen in passing + + on windows, the return values from wait() and waitpid() don't + match those of pseudo-pids + + waitpid() now handles externally spawned pids correctly; + fixes for backtick/wait/waitpid failures on Windows 9x + these changes make the pid returned by process functions on + Windows 9x always positive by clearing the high bit (which + is always set on Win9x); pseudo-process PIDs are likewise + always negative now on Win9x (just as on NT/2000) + + trailing new %ENV entries weren't being pushed into the real + environment of subprocesses on Windows + + Tweak the regex compilation errors once more. + + avoid warnings from dense compiler + + add "ok" targets from change#6632 in makefile.mk + Branch: maint-5.6/perl + - lib/Pod/PlainText.pm vms/configure.com + !> (integrate 66 files) +____________________________________________________________________________ +[ 7885] By: gsar on 2000/11/27 13:53:18 + Log: integrate changes#6540..6541,6546..6549,6552..6554,6557..6606, + 6610..6611 from mainline + + Make regular expression parse error messages easier to understand. + Subject: Re: enhanced(?) regex error messages + + Tiny tidying on report_evil_fh(). + + Subject: Re: enhanced(?) regex error messages + plus Capitalize the error messages, plus perldiag them. + + Subject: Patch against 5.6.0 to allow "-d:Module=arg,arg,arg" + + Document here-doc better. + + Subject: [ID 20000807.003] [PATCH] Debugger treatment of condition "0" + + Subject: [PATCH] Re: [ID 20000807.008] Double reads considered evil? (deja vu) + Do away with array context, from Daniel Chetlin + (either perlbug or p5p ate the original), plus regen + perlapi and perltoc. + + Regen global.sym. + + Double check that we have a dirhandle. + + Subject: Re: enhanced(?) regex error messages + (plus two small patches sent privately) + (this still seems to leave few test failures) + + warn is a macro, avoid using at a variable to avoid warnings + in some configurations; readdir.t is too conservative in + estimating number of *.t's + + Get back into sync with Jeffrey on the enhanced regex warnings. + + Subject: [PATCH 5.6.0] cygwin port + + Zero entries were skipped, fix from Adrian Goalby + + + Subject: Remove dead entry in perldiag + + Amend the description of Perl6. + Subject: [PATCH Perl-5.6.0] perlfaq1.pod + + detypo + + It's the 2ndO'ROSSC. + + Revert the sv.c part of #6559, a better fix is needed. + + Iterating perl6 description. + + Update to Term::ANSIColor 1.03, from Russ Allbery. + + Update to Getopt::Long 2.23_05, from Johan Vromans. + + Small AUTHORS and MAINTAIN updates. Could do with big updates. + + Update to Pod::Parser 1.17, from Brad Appleton. + + Update to CPAN 1.56, from Andreas König. + + Update to CGI 2.70, from Lincoln Stein. + + Put back the std @INC thing. + + Fixes to looking-like-number to keep behaviour as it was in 5.005_03. + Subject: Re: [ID 20000810.002] $a["1foo"] same as $a[0] + + Document the IO::Select timeout. + + sleep(1) does not necessarily return 1. + Subject: [PATCH bleadperl] op/lex_assign.t + + Subject: debugger "d" command doesnt check line number + + B::Deparse didn't do sub attributes. + Subject: B::Deparse was Re: [ID 20000808.005] refs to returned lvalues are lvalues?? + + Preprocessing and postprocessing for File::Find. + Subject: Patch to Find::File.pm to allow alphabetical results + + Subject: Re: [ID 20000809.005] trouble with long string and /m modifier - uninitialized value + + Subject: Re: [ID 20000809.006] Debugger lost the ability to see $1 et al + + Subject: Re: [ID 20000730.003] utf8::length() bad + + Subject: Getting perlio and threads to compile + (the Solaris version changes in Configure skipped) + + Tests for #6589. + Subject: Re: B::Deparse was Re: [ID 20000808.005] refs to returned lvalues are lvalues?? + + Add Perl debugging tutorial, regen toc. + Subject: perldebtut.pod + + Add a few missing files, update MANIFEST. + + Rewrite of vms/subconfigure.com as configure.com, + from Peter Prymmer and the vmsperl crew. + + Should have deleted this in #6603. + + Fix the test for 5005threads. + + Fix-n-skip the tests under 5005threads. + + Subject: [PATCH] t/op/regmesg.t fails if REG_INFTY set + + Upgrade to CGI 2.71, from Lincoln Stein. + Branch: maint-5.6/perl + +> lib/CGI/eg/make_links.pl lib/CGI/eg/wilogo.gif + +> lib/Pod/PlainText.pm pod/perldebtut.pod t/lib/gol-oo.t + +> t/op/regmesg.t t/pod/find.t vms/configure.com + - vms/subconfigure.com + ! lib/lib.pm + !> (integrate 115 files) +____________________________________________________________________________ +[ 7883] By: gsar on 2000/11/27 11:50:46 + Log: integrate changes#6469..6484,6486..6501,6504..6505,6507..6509, + 6511..6513,6515..6523,6525..6536 + + The swallow_bom() saga continues. The #23 of require.t + (UTF16-LE) still fails (silently, no output) but the #22 + (UTF16-BE) seems to be working now. The root of the + failure may be in sv_gets(): is it UTF-16LE-aware, + especially when it comes to line endings? + + Document the problem with -P in HP-UX and its workaround. + + Subject: [PATCH] allow non-variable as lhs of non-updating tr/// + (aka ID 20000730.002) + + Subject: fix and question re: waitpid() under win32 + + Make the safety catch for buggy gccs work with triple version + numbers like 2.95.2. Reported in + Subject: [ID 20000731.005] Perl 5.6.0 "Configure" fails to recognize gcc 2.95.2 + + In Digital UNIX warn if gcc explicitly chosen because even + 2.95.2 is known to cause problems. + + Make chr() for values >127 to create utf8 when under utf8. + + various syntax errors and such (not fixed: comp/require.t#22 coredump + on Windows) + + Stash away the largefiles flags and libswanted. + + BOM patching from Simon Cozens. + + If gccosandvers is equal to osname, clear gccosandvers. + + Make p4desc to skip non-mainperl branches by default. + + Subject: [Proposed PATCH] Let Perl define QUAD_MIN and _MAX itself + + The test from this + Subject: Re: [ID 20000411.002] qw() gives different results in 5.6 to previous versions + + In new BSDs changes to argv[] do not show up in ps(1) output, + instead one must use setproctitle(). This was already addressed + by change #6457, but the below has a new variant for FreeBSD 4.0 + or later, and the matter is also documented more. + + FreeBSD 3.* updates from + Subject: [ID 20000801.007] setting $0 on FreeBSD 4.x does not get reflected in /bin/ps + + regen_headers, regen perltoc. + + Document in one place the memory abstractions used in Perl core. + + memcpy has n o in it, as pinted ut by Sarathy. + + Remove the extraneous "main::" prefix from all the + "opened only for", "on closed", and "never opened" warnings. + + The name of a filehandle does not have . + + The tr utf8 patching continues. + + The new setproctitle() feature is available only in + bleeding edge FreeBSD. From Paul Saab. + + Subject: [PATCH bleadperl] [ID 20000731.010] regex error + + Dump UVs as UVs in Data::Dumper. + + detypo #6494 + + Document the IVdf UVuf UVof UVxf. + + require.t needs binmode() to work on windows + + Generate OP_IS_SOCKET() and OP_IS_FILETEST() macros + that are hopefully soon put into use. + + Allow "no Module;" even if there is no 'unimport'. + + Better skip message for the test; one of the two problems in + Subject: [ID 20000224.003] Not OK: perl v5.5.660 on i86pc-solaris 2.7 + + The subtest 4 may fail also on VOBS, as pointed out + by Nick Ing-Simmons in November 1999, bug id 19991124.003 + (but the failure in that bug report isn't the subtest 4). + + Be more informative on what is skipped and why, + also repeat the list at the end. + + Add a URL for FSF. + + Subject: [PATCH] sv.h documentation - SvLEN + + Subject: [PATCH bleadperl] [ID 20000803.001] further regexp counting problems + + Subject: [PATCH perl-current] Comings and goings in op/sprintf.t + + Subject: [PATCH] bad cppsymbols on os2 + Configure question + + Subject: [ID 20000802.002] [PATCH] memory pseudo-leak in sv_dump + + Subject: [ID 20000802.004] Tests op/grent.t and op/pwent.t fail unnecessarily + mention the idea of @( and @) + + This is 6512. Really. + + Subject: [ID 19990721.004] Documentation bug in perlfunc + + Subject: Minor tweak to perlvar.pod + + In the warnings call filehandles consistently so; + add "unopened" warning for stat(). + + After the #6519 a warning about stat() is just that, + not about a filetest, which now have their own warning. + + Subject: [ID 20000804.002] configure.gnu and arguments with whitespace characters + + Subject: Re: Array vs. List context + + Subject: New perlcc, take 2 + + Weed buglets pointed out by + Subject: Re: [ID 20000803.005] miniperl aborts during Perl make + + gcc versions might have (parentheses) in them. + + Subject: [ID 20000724.004] Perl interpreter segfault when using built-in flock + + Essential prototype changes were missing from #6527. + Also make report_evil_fh() more bomb-proof. + + Zap lib/Sys directory when cleaning up. + + Change the Policy policy: now -Dprefix= with an existing + Policy.sh and prefix == siteprefix == vendorprefix, then all + of them follow along the new prefix. + Subject: Re: [ID 20000508.002] -Dprefix completely broken [PATCH] + + Continue fixing the io warnings. This also + sort of fixes bug ID 20000802.003: the core dump + is no more. Whether the current behaviour is correct + (giving a warning: "Not a format reference"), is another matter. + + Have symbols for the IoTYPEs. + + Subject: [PATCH] perlfunc.pod use documentation (5.6.0) + + Document a bit that UDP is not what you might think. + Subject: Re: IO::Socket::INET bug sending large UDP packets/fragmentation + tr memory corruption fix from Simon Cozens. + + Plug the security hole described in the Aug 05 2000 bugtraq message + "sperl 5.00503 (and newer ;) exploit" by Michal Zalewski. + The security hole exists only in suidperls, which isn't + installed or even built by default. + Branch: maint-5.6/perl + !> (integrate 71 files) +____________________________________________________________________________ +[ 7882] By: gsar on 2000/11/27 10:25:36 + Log: integrate changes#6439..6444,6446..6453,6455..6457,6460..6465,6467..6468 + from mainline + + Make the unimplemented POSIX regex features [[.cc.]] and [[=c=]] + to be fatal errors (instead of by default ignoring them, and + ignoring with a bug: even though -w gave an error, the opening [ + was left in) Reported in: + + Subject: [PATCH: perl@6409] bug fix for munchconfig (turned up by CXX) + + Subject: [PATCH] split /^/ + + MacOS nits from Matthias Neeracher. + + More split() doc and test patches from Mike Guy. + + Allow "sub AUTOLOAD;" to stop AUTOLOAD inheritance, + from Graham Barr in the module list. + + docfix from Peter Scott . + + File::Temp patches for VMS and OS/2 from Tim Jenness. + + open() wariness in perlbug. + + Subject: [PATCH] minor doc change - perlguts + + Subject: Minor doc patch: handy.h + + Be wary of close()s, too. + + Further File::Temp patches from Yitzchak Scott-Thoennes + and Craig A. Berry. + + Subject: [PATCH] fixes bug 20000508.004 + + Subject: [ID 19990709.002] [DOCUMENTATION PATCH] perldiag + + Allow "no AutoLoader;", based on change #6444, + suggested by Graham Barr. + + Use setproctitle() if available to modify $0. + + Warn if the version of the operating system used to compile gcc + differs from the current version of the operating system. + Also display the gcc compilation os and version in myconfig. + Inspiration from + + Tiny fixes for #6460. + + The problem described in this + Subject: [ID 20000322.018] named chars aren't magical enough + has been fixed in perl 5.6.0 but just in case added a test + to keep it away. (The report from Joseph Hall.) + + Tune the comments and hopefully stop a memory leak. + + Subject: UTF8 concat + (with a memory leak fixed, plus a few casts added) + This also seems to help for + Subject: [ID 20000716.015] join UTF8 weirdness + + Do not upgrade SVs into utf8 just because they participate + in eq or cmp. Reported and fix suggested in + Subject: [ID 20000720.009] sv_eq UTF8 bug + + Fix the HALF_UPGRADE() macro introduced in #6263. + + Find green threads before native threads. + Subject: Re: Patch to jpl/JNI/Makefile.PL + Branch: maint-5.6/perl + !> (integrate 30 files) +____________________________________________________________________________ +[ 7846] By: gsar on 2000/11/24 00:55:57 + Log: integrate changes#6415..6418,6420..6438 from mainline + + Fix the bitvector ops for utf8 (tricky since past 7 bits + the utf8 'characters' can be more than one octet). + + MPE/ix updates for perl 5.6.0 from Mark Bixby. + + Subject: SDBM_File documentation + + Detypo. + + Decutandpasto. + + Send all installperl messages to STDERR and be -w clean. + + Out-of-date note removed. + + Protect against "wild next"s, that is, callbacks doing "next" + instead of "return". + + Use STDOUT consistently. + + The output might have been produced in the wrong order. + + A missing 'break' after the [[:space:]] switch case. + + Add tests for + [ID 19991110.003] another matching finding by pcre author + which has already been fixed by some patch, as verified in + + Documentation to explain the behaviour of map(). + + Add an optimization for map-maps-a-list-element-to-more-list-elements + case, but add also notes explaining the relationship of this + patch and the earlier notes by Sarathy. + + Subject: [ID 20000716.023] syslog test fails without sockets + + Subject: Re: [PATCH] [ID 20000716.011] strangeness with split($_ =~ m/.../) + Test cases for #6431. + + File::Spec::VMS fixup for tmpdir from Craig Berry. + + Make the "uninit variable" warning to say "concat or string" + or "join or string" when in concat or join . + + Get UTF16 BOMs working. Patch from + Subject: Re: [ID 20000719.001] Problem with bleadperl of 7/18/00 + + Subject: [PATCH] Make large file tests deal with SIGXFSZ + + Subject: [ID 20000724.003] Documentation changes for perllocale.pod + + Subject: [PATCH] av.c apidoc + Branch: maint-5.6/perl + !> (integrate 43 files) +____________________________________________________________________________ +[ 7845] By: gsar on 2000/11/24 00:20:45 + Log: integrate changes#6406..6414 from mainline + + Merge perlhacktut into perlhack, update perlguts. + + Fix AutoSplit to use File::Spec the right way in VMS, + from Peter Prymmer. + + The bug report + [ID 19991110.002] minimal matching discrepancy found by pcre author + seems to have been fixed (though differently from what was suggested + in the report) in 5.6.0. Add tests to keep the bug from reappearing. + + thinko fix in vms/descrip_mms.template, the win32.pod in lib, + not in pod, from Peter Prymmer + + Subject: [docpatch] Re: [ID 19991002.011] perldoc -f shift + From: Hugo + Date: Fri, 14 Jul 2000 23:05:20 +0100 + Message-Id: <200007142205.XAA17882@crypt.compulink.co.uk> + + Didn't anymore apply, but that point still could use another fix. + + lib/b test fixes from Peter Prymmer. + + More docs for sv functions. + + perlvms.pod whitespace cleanup to keep pod utils happy. + + another VMS build tweak from Peter Prymmer + Branch: maint-5.6/perl + !> embed.pl lib/AutoSplit.pm pod/perlapi.pod pod/perlfunc.pod + !> pod/perlguts.pod pod/perlhack.pod sv.c t/lib/b.t t/op/re_tests + !> vms/descrip_mms.template vms/perlvms.pod +____________________________________________________________________________ +[ 7799] By: gsar on 2000/11/22 01:02:56 + Log: some lib_pm.PL changes snuck in via change#7772 + Branch: maint-5.6/perl + ! Makefile.SH +____________________________________________________________________________ +[ 7781] By: gsar on 2000/11/20 19:02:55 + Log: type mismatch due to faulty integration + Branch: maint-5.6/perl + ! toke.c win32/Makefile +____________________________________________________________________________ +[ 7780] By: gsar on 2000/11/20 17:31:55 + Log: integrate changes#6392,6394..6399,6401..6404 + + The {multiplier} of a fixed substring was overlooked which + caused a wrong initial search offset for that substring. + + Subject: [PATCH 5.6.0] Re: [ID 20000613.001] Regex works in v5.005_03 but fails in v5.06 + From: Hugo + Message-Id: <200007131827.TAA14487@crypt.compulink.co.uk> + Date: Thu, 13 Jul 2000 19:27:13 +0100 + + Fix the BOM bug: not a byteorder bug, a signedness bug. + + Replace change #6337 with a better one. + + Subject: Re: [PATCH] [ID 20000701.002] Regular Expressions Not Unsetting $1 Vars When Backtracking + From: Hugo + Date: Fri, 14 Jul 2000 04:16:20 +0100 + Message-Id: <200007140316.EAA15857@crypt.compulink.co.uk> + + MakeMaker should not remove editor backups (*~) on `make clean` + by default (completes change#6383) + + move new variables to the end of the interpreter structure (for + bincompat in code that doesn't #include XSUB.h) + + rename totally bletcherous SvLOCK() thingy (doesn't do what the + name suggests anyway) + + various cleanups (typos, misformatted code, and small bugs) + + typecasts needed for change#6394 + + typos in change#6399, regen headers + + inconsistent types needs casts + + PERL_OBJECT build tweaks + Branch: maint-5.6/perl + !> MANIFEST doop.c embed.h embed.pl embedvar.h + !> ext/IPC/SysV/Makefile.PL global.sym intrpvar.h + !> lib/ExtUtils/MM_Unix.pm mg.c op.c perlapi.h pod/perlapi.pod + !> pp.c proto.h regcomp.c regexec.c sv.h t/op/re_tests thread.h + !> toke.c util.c +____________________________________________________________________________ +[ 7779] By: gsar on 2000/11/20 17:06:29 + Log: integrate changes#6376..6378,6380,6383,6385..6388,6391 + + Cosmetics and perldelta. + + Fix nits noticed by Boston.pm. + + Do the cc sanity check both before the hints and + after the cc selction. + + get sprintf.t to adjust properly for 3-digit exponents + + don't clobber *.orig files on *clean targets + + fix bugs in processing %v-*d and similar format specs (from + Avi Finkel ) + + sprintf test tweaks (from Dominic Dunlop) + + new selfloader.t in change#6183 doesn't close DATA handles, + and thus fails to clean up tmp files on dosish platforms + + typos (spotted by Peter Prymmer) + + typo fix from Craig Berry + Branch: maint-5.6/perl + !> Configure Makefile.SH config_h.SH ext/IPC/SysV/Makefile.PL + !> pod/perldelta.pod pod/perlre.pod sv.c t/lib/english.t + !> t/lib/selfloader.t t/op/sprintf.t vms/subconfigure.com + !> x2p/Makefile.SH +____________________________________________________________________________ +[ 7778] By: gsar on 2000/11/20 16:46:51 + Log: integrate changes#6340..6342,6348,6354,6356,6357,6371,6372,6375 + + Subject: Re: format bug report [Patch] + From: "H.Merijn Brand" + Date: Wed, 05 Jul 2000 13:12:52 +0200 + Message-Id: <20000705130745.67BF.H.M.BRAND@hccnet.nl> + + Subject: Re: format bug report [Patch] + From: "H.Merijn Brand" + Date: Wed, 05 Jul 2000 14:10:01 +0200 + Message-Id: <20000705140837.73C2.H.M.BRAND@hccnet.nl> + + Subject: Re: [ID 20000704.002] [PATCH] memory leak with debug / anon subs + From: "M.J.T. Guy" + Message-Id: + Date: Fri, 07 Jul 2000 17:57:16 +0100 + + Subject: [ID 20000710.002] fatal error or memory loss when deleting symbols in evaled code with syntax errors + To: perl5-porters@perl.org + From: Karsten Sperling + Date: Mon, 10 Jul 2000 15:12:52 +0200 + Message-Id: <200007101315.e6ADFrg21041@chthon.perl.com> + + README.posix-bc podified from Thomas Dorner. + + Subject: [PATCH perl-current] Make op/sprintf.t more comprehensive, take2 + From: Dominic Dunlop + Date: Tue, 11 Jul 2000 12:27:33 +0200 + Message-Id: + + Typo in #6341. + + Fix for + Subject: [ID 20000711.005] spurious uninit warning with msgrcv() + From: Roderick Schertler + Date: Tue, 11 Jul 2000 13:55:05 -0400 + Message-Id: <200007111755.NAA05077@jones.argon.org> + + Minor cleanups on the booklist. + + Reintroduce perlbook (updated for Mk III), introduce perlposix-bc, + regen perltoc. + + windows build tweaks (op/sprintf.t still fails tests 120-121, 149) + Branch: maint-5.6/perl + +> pod/perlbook.pod + !> MANIFEST README.posix-bc doio.c lib/Symbol.pm pod/Makefile.SH + !> pod/buildtoc.PL pod/perl.pod pod/perlfaq2.pod pod/perltoc.pod + !> pp_hot.c t/op/sprintf.t t/op/write.t toke.c win32/win32sck.c +____________________________________________________________________________ +[ 7772] By: gsar on 2000/11/20 13:06:23 + Log: integrate changes#6315..6319,6321..6331,6333..6338 + + Integrate with Sarathy, preliminary fix for unicos + alignment problems in [ID 20000612.002] Perl problem on Cray system. + + some debugger output does not go to the socket when RemotePort is set + + winsock cleanup never done on Windows (leads to handle leaks) + + fix UNC path handling on Windows under ithreads, and chdir() + return value when given a non-existent directory + + Autogenerate pod/Makefile and pod/buildtoc. + buildtoc also checks whether the existin pods are + mentioned in MANIFEST and perl.pod, and vice versa. + (None of the thusly found discrepancies fixed yet.) + roffitall also needs to be autogenerated similarly but it + seems so badly out of date that I didn't touch it yet. + + Config is being used. + + Add =head1 NAMEs so that buildtoc is happy. + (The CGI::Util nit reported to Lincoln.) + + Fix complaints of buildtoc. + + Fix the alignment problem in Crays ([ID 20000612.002]). + + Remove perlbook, update perlfaq book listing, + rearrange perl.pod, regenerate perltoc. + + Fix a nit spotted by 64bit IRIX compilation: a (64-bit) pointer + was cast to an unsigned (32-bit) integer with wild abandon. + + winsock options weren't being set in all threads under ithreads + (caused send()s from second and subsequent threads to fail) + + accept() leaks memory on windows due to incorrect ordering of + closesocket() and fclose() calls + + Reorder perl.pod once more. + + More POSIX.pod tweaks. + + Sprinkle ldlibpath. + + Precedence goof, fix based on + Subject: [PATCH 5.6.0] op/taint.t continues on failed shmget() + From: Hugo + Date: Tue, 11 Jul 2000 12:52:38 +0100 + Message-Id: <200007111152.MAA05488@crypt.compulink.co.uk> + + Subject: PATCH perlguts.pod: Document D and d magic types + From: mjd@plover.com + Date: 5 Jul 2000 18:01:51 -0000 + Message-ID: <20000705180151.29413.qmail@plover.com> + + Subject: [ID 20000705.002] problem with perl 5.6.0 on NetBSD/sparc + From: Hubert Feyrer + Date: Wed, 5 Jul 2000 14:56:43 +0200 (MET DST) + Message-Id: + + Subject: [PATCH cfgperl] $& segfaults if you trick it + From: simon@brecon.co.uk (Simon Cozens) + Date: 7 Jul 2000 11:26:09 GMT + Message-ID: + + Subject: [PATCH] [ID 20000701.002] Regular Expressions Not Unsetting $1 Vars When Backtracking + From: Hugo + Date: Tue, 11 Jul 2000 12:44:50 +0100 + Message-Id: <200007111144.MAA04446@crypt.compulink.co.uk> + + Subject: [PATCH] Re: "%#p" format specifier: document and test or not? + From: "M.J.T. Guy" + Date: Tue, 11 Jul 2000 13:50:51 +0100 + Message-Id: + Branch: maint-5.6/perl + +> ext/DynaLoader/hints/netbsd.pl lib/Win32.pod pod/Makefile.SH + +> pod/buildtoc.PL + - pod/Makefile pod/Win32.pod pod/buildtoc pod/perlbook.pod + !> (integrate 26 files) +____________________________________________________________________________ +[ 7771] By: gsar on 2000/11/20 12:31:42 + Log: integrate changes#6283..6285,6291,6294..6300,6302..6304,6306..6307, + 6310,6311,6314 + + Subject: [PATCH bleedperl] File::Spec 0.82 beta + From: Barrie Slaymaker + Date: Wed, 28 Jun 2000 11:35:29 -0400 + Message-Id: <200006281535.LAA21095@jester.slaysys.com> + + tweak perlembed for multiplicity/usethreads sanity; correct notes + about Windows + + localize %INC in a Safe compartment so that use/require work + (many other magic globals probably need similar treatment) + + dounwind() may cause POPSUB() to diddle the wrong PL_curpad + when @_ is modified, causing coredumps + + slurp mode fix in change#4736 still not quite right + + Point to perlipc for more SysV IPC examples. + + Elaborate POSIX.pod. Still needs work. + + fix ~320 byte memory leak (psig_{ptr,name} tables were never freed) + + fix large memory leak that has been around for ever, masked by + -DPURIFY (most of the arenas were never freed!) + + fix memory leak on Windows (PL_sys_intern contents were never + freed) + + PERL_OBJECT build tweak + + adjust change#6299 + + remove rel2abs prototypes (from Barrie Slaymaker) + + missing perldiag entry for unpack("w",...) diagnostic (from + Andreas Koenig) + + better diagnostic on Frob->stuff() when Frob:: doesn't exist + (from Richard Soderberg ) + + Win32 patches for cfgperl from Sarathy. + + b.t fails under OS/2 (from Yitzchak Scott-Thoennes) + + More POSIX.pod embellishment. + + tyop in change#6306 + Branch: maint-5.6/perl + !> (integrate 44 files) +____________________________________________________________________________ +[ 7770] By: gsar on 2000/11/20 11:51:00 + Log: integrate changes#6268..6282 from cfgperl branch + + Subject: [PATCH perl-current] Make op/sprintf.t more comprehensive + From: Dominic Dunlop + Date: Thu, 29 Jun 2000 12:32:39 +0200 + Message-Id: + + Regen headers for #6261 (and update embed.pl for this) and #6267, + silence few compiler warnings. + + Subject: PATCH (Re: [ID 20000612.004] Should regression tests fail if user doesn't build XS extensions?) + From: Nicholas Clark + Date: Fri, 23 Jun 2000 16:21:15 +0100 + Message-ID: <20000623162115.A19894@Bagpuss.unfortu.net> + + Subject: PATCH pod/perltie.pod + From: Ian Phillipps + Date: Fri, 16 Jun 2000 00:17:19 +0100 + Message-ID: <20000616001719.A17108@homer.diplex.co.uk> + (only the first hunk, the second hunk had already been done + by some other patch) + + Subject: [ID 20000614.005] [patch] Tweak to Net::Ping docs + From: Tom Phoenix + Received: (qmail 6398 invoked by uid 508); 15 Jun 2000 00:30:54 -0000 + Date: Wed, 14 Jun 2000 17:30:37 -0700 (PDT) + + Subject: [PATCH] xsub attributes + From: Doug MacEachern + Date: Wed, 14 Jun 2000 15:09:22 -0700 (PDT) + Message-ID: + + Subject: [ID 20000614.003] 5.6.0 File/Glob.pm incompatibility + From: Andy Dougherty + Date: Wed, 14 Jun 2000 13:33:32 -0400 (EDT) + Message-Id: + + Subject: [PATCH] 5.6.0 lib/Pod/{Html,Man,Text}.pm + From: "Daniel S. Lewart" + Date: Tue, 13 Jun 2000 02:43:48 -0500 + Message-ID: <20000613024347.A28388@staff2.cso.uiuc.edu> + + Subject: [PATCH] Re: eval documentation: context + From: "M.J.T. Guy" + Date: Mon, 12 Jun 2000 15:07:29 +0100 + Message-Id: + + Subject: [PATCH] Re: [ID 20000612.001] map {chop; $_} (Literals problem) + From: "M.J.T. Guy" + Date: Mon, 12 Jun 2000 14:55:59 +0100 + Message-Id: + + Subject: [ID 20000609.002] Text::Wrap::wrap does not handle multiline strings properly + From: "Milton L. Hankins" + Date: Fri, 09 Jun 2000 12:39:27 -0400 + Message-Id: <39411DBF.A04BB1A@swl.msd.ray.com> + (plus update the version "number" of Text::Wrap) + + Subject: [ID 20000602.002] [PATCH] perlsub.pod: ambiguous usage of "closure" + From: Tim Ayers + Date: Thu, 08 Jun 2000 08:11:06 +0200 + Message-id: <393F38FA.9B5F4C7D@m.dasa.de> + [resent by Richard Foley, Message-Id probably wrong] + + Subject: Re: backwards compatibility in h2xs and makemaker [PATCH] + From: rspier@pobox.com (Robert Spier) + Date: Wed, 7 Jun 2000 12:47:37 -0400 (EDT) + Message-ID: <14654.31913.845602.610277@rls.cx> + + Subject: [PATCH 5.6.0] utils/h2xs.PL + From: "Daniel S. Lewart" + Date: Wed, 7 Jun 2000 04:02:04 -0500 + Message-ID: <20000607040201.A22568@staff1.cso.uiuc.edu> + + Subject: [PATCH 5.6.0]ITHREADs for VMS + From: Dan Sugalski + Date: Tue, 06 Jun 2000 11:59:50 -0400 + Message-Id: <4.3.2.7.0.20000606115752.01c82220@24.8.96.48> + Branch: maint-5.6/perl + !> (integrate 31 files) +____________________________________________________________________________ +[ 7769] By: gsar on 2000/11/20 11:29:06 + Log: integrate changes#6261..6266 from cfgperl + + Subject: Re: [PATCH cfgperl] BOMs away! + From: simon@brecon.co.uk (Simon Cozens) + Date: 17 Jun 2000 11:49:57 GMT + Message-ID: + + Subject: 5.6.0 Patch for EPOC + From: Olaf Flebbe + Date: Tue, 13 Jun 2000 22:59:29 +0200 (MEST) + Message-ID: <23449.960929969@www11.gmx.net> + + tr fixes from Simon Cozens + + Subject: [ID 20000628.004] Re: Problem compiling perl? [BSDI-Support-Request #71232] + From: Marty Lucich + Date: Wed, 28 Jun 2000 14:16:05 -0700 (PDT) + Message-Id: <200006282116.OAA11148@netcom.com> + ccdlflags update (the BSD/OS 4.1 part had already been taken + care of by #6141). + + Subject: Re: [ID 20000628.006] POSIX::STRERR_FILENO typo + From: sthoenna@efn.org (Yitzchak Scott-Thoennes) + Date: Wed, 28 Jun 2000 17:50:12 -0700 + Message-ID: + + Subject: [PATCH 5.6.0] cygwin port + Message-ID: <779F20BCCE5AD31186A50008C75D997917173C@silldn_mail1.sanwaint.com> + From: "Fifer, Eric" + Date: Thu, 29 Jun 2000 12:58:29 +0100 + Branch: maint-5.6/perl + !> README.epoc cygwin/Makefile.SHs doop.c epoc/config.sh + !> epoc/createpkg.pl epoc/epocish.c epoc/epocish.h + !> ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs + !> hints/bsdos.sh pod/perldiag.pod t/comp/require.t toke.c +____________________________________________________________________________ +[ 7768] By: gsar on 2000/11/20 11:13:44 + Log: integrate changes#6252..6256,6259..6260 + + Paranoia tweak on #6249. + Subject: Re: [PATCH 5.6.0 IPC/Open3.pm] Allow the use of numeric fd's + From: Ronald J Kimball + Date: Sun, 25 Jun 2000 23:43:12 -0400 + Message-ID: <20000625234312.B74147@linguist.dartmouth.edu> + + Subject: tr///, help wanted. + From: simon@brecon.co.uk (Simon Cozens) + Date: 28 Jun 2000 11:29:04 GMT + Message-ID: + + small thinko tweaks + + tweaks from Simon Conzes to further fix tr/// under utf8 + + perlnewmod was missing from MANIFEST. + + Subject: Re: [PATCH] pack('U',$foo) doesn't UTF8 + From: simon@brecon.co.uk (Simon Cozens) + Date: 17 Jun 2000 11:56:44 GMT + Message-ID: + pack U0, pack C0 + Branch: maint-5.6/perl + !> MANIFEST doop.c embed.h embed.pl embedvar.h global.sym + !> lib/Exporter.pm lib/IPC/Open3.pm objXSUB.h op.c + !> pod/perlfunc.pod pp.c pp_proto.h proto.h sv.c t/op/my_stash.t + !> t/op/pack.t t/op/tr.t t/pragma/constant.t t/pragma/warn/op +____________________________________________________________________________ +[ 7767] By: gsar on 2000/11/20 10:51:38 + Log: integrate change#6250 from cfgperl + + Subject: Re: [PATCH] support 'my __PACKAGE__ $obj = ...' + From: Doug MacEachern + Date: Tue, 27 Jun 2000 14:17:28 -0700 (PDT) + Message-ID: + Branch: maint-5.6/perl + +> t/op/my_stash.t + !> MANIFEST embed.pl global.sym proto.h toke.c +____________________________________________________________________________ +[ 7766] By: gsar on 2000/11/20 10:48:34 + Log: integrate changes#6240,6242..6246,6248,6249 from cfgperl + + Subject: [ID 20000626.007] h2xs man page contains trailing garbage + From: Nicholas Clark + Date: Mon, 26 Jun 2000 18:40:14 +0100 + Message-Id: <200006261740.SAA02740@Bagpuss.unfortu.net> + + Subject: [PATCH] bytes<->utf8 fixes + From: simon@brecon.co.uk (Simon Cozens) + Date: 26 Jun 2000 04:55:45 GMT + Message-ID: + + Subject: [PATCH] is_utf8_string + From: simon@brecon.co.uk (Simon Cozens) + Date: 26 Jun 2000 02:25:59 GMT + Message-ID: + + Subject: [PATCH] avoid mg_ptr in '*' magic + From: Doug MacEachern + Date: Sun, 25 Jun 2000 11:16:08 -0700 (PDT) + Message-ID: + + Subject: [ID 20000624.001] PERL_DL_DEBUG=1 DynaLoader message appears to be wrong + From: Nicholas Clark + Date: Sat, 24 Jun 2000 13:06:20 +0100 + Message-Id: <200006241206.NAA03771@Bagpuss.unfortu.net> + + Allow for standalone testing. + + Subject: DOC PATCH 5.6.0: perlfunc/sprintf does not contain an example + From: Mark-Jason Dominus + Date: Tue, 27 Jun 2000 22:36:42 -0400 + Message-ID: <20000628023642.12166.qmail@plover.com> + + Subject: Re: [PATCH 5.6.0 IPC/Open3.pm] Allow the use of numeric fd's + From: Frank Tobin + Date: Sun, 25 Jun 2000 19:00:58 -0500 (CDT) + Message-ID: + Branch: maint-5.6/perl + !> embed.h embed.pl embedvar.h ext/DynaLoader/DynaLoader_pm.PL + !> global.sym gv.c lib/IPC/Open3.pm objXSUB.h perlapi.c perlapi.h + !> pod/perlapi.pod pod/perlfunc.pod pod/perlintern.pod pp_proto.h + !> proto.h sv.c t/lib/filefunc.t t/lib/filespec.t t/lib/peek.t + !> utf8.c utils/h2xs.PL +____________________________________________________________________________ +[ 7765] By: gsar on 2000/11/20 10:29:13 + Log: integrate change#6239 from cfgperl + + Configure maintenance. Sever some dependency cycles, + separate gccversion from the cc unit, + address [ID 20000623.006] Configure script patch for using gcc on AIX + (but solve it a little bit differently), + unduplex some accidentally duplicated units, + suggest using gcc if no cc available + (p5p thread: "Solaris configure: counterproposal", 1999-09) + Branch: maint-5.6/perl + !> Configure Todo-5.6 config_h.SH +____________________________________________________________________________ +[ 7764] By: gsar on 2000/11/20 10:25:55 + Log: integrate changes#6233..6238 from cfgperl + + Subject: PATCH 5.6.0: Document OPf_SPECIAL flag in regcomp op nodes + From: Mark-Jason Dominus + Date: Fri, 16 Jun 2000 20:53:04 -0400 + Message-ID: <20000617005304.8008.qmail@plover.com> + + Prefer C:/temp in Win32 as File::Spec->tmpdir to /tmp + because when run as services (Win32ese for daemons) + no environment variables are set and tmpdir ends up as /tmp, + which is ambiguous. + Subject:[ID 20000616.002] File::Spec->tmpdir broken when running as service + From: matt@sergeant.org + Date: 16 Jun 2000 16:30:43 -0000 + Message-Id: <20000616163043.26398.qmail@mail.sergeant.org> + + The thread begun by + Subject: [ID 20000616.001] Typo on line 390 of .../hints/solaris_2.sh + From: Kevin.Ruscoe@ubsw.com + Date: Fri, 16 Jun 2000 16:38:51 +0100 + Message-Id: + + Tweak embed.pl, regen headers. + + Subject: [PATCH 5.6.0] XS module loading fixup for VMS + From: Dan Sugalski + Date: Fri, 23 Jun 2000 17:00:00 -0400 + Message-Id: <4.3.2.7.0.20000623165934.00c93d10@24.8.96.48> + Branch: maint-5.6/perl + !> (integrate 27 files) +____________________________________________________________________________ +[ 7763] By: gsar on 2000/11/20 10:08:08 + Log: s/perl56delta/perldelta/g + Branch: maint-5.6/perl + ! pod/Makefile +____________________________________________________________________________ +[ 7762] By: gsar on 2000/11/20 10:04:00 + Log: integrate changes#6225,6229,6231,6232 from cfgperl + + Add source code filenames to apidoc. + From: simon@brecon.co.uk (Simon Cozens) + Subject: [PATCH embed.pl] Source X-ref + Date: 22 Jun 2000 02:18:49 GMT + Message-ID: + + Subject: README.hpux version 0.6.1 + Date: Tue, 20 Jun 2000 15:25:51 -0700 (PDT) + From: Jeff Okamoto + Message-Id: <200006202225.PAA26205@xfiles.intercon.hp.com> + + Subject: [PATCH 5.6.0] cygwin port + From: "Fifer, Eric" + Date: Tue, 20 Jun 2000 14:30:58 +0100 + Message-ID: <779F20BCCE5AD31186A50008C75D9979171734@silldn_mail1.sanwaint.com> + + Subject: PATCH: pod/perlutil.pod - utilities packaged with the Perl distribution + From: simon@brecon.co.uk (Simon Cozens) + Date: 19 Jun 2000 15:18:27 GMT + Message-ID: + + plus update pod/Makefile and regenerate perltoc + Branch: maint-5.6/perl + +> pod/perlutil.pod + !> MANIFEST README.cygwin README.hpux Todo-5.6 embed.pl + !> lib/File/Find.pm pod/Makefile pod/perltoc.pod pod/roffitall +____________________________________________________________________________ +[ 7344] By: gsar on 2000/10/16 09:30:21 + Log: integrate change#6220 from cfgperl + + Win32 patches from Benjamin Stuhl. + Branch: maint-5.6/perl + !> makedef.pl win32/win32.h +____________________________________________________________________________ +[ 7343] By: gsar on 2000/10/16 08:32:19 + Log: integrate changes#6221,6222 from cfgperl + + Remove tr///CU (the feature is to be obsoleted by better interfaces). + From: simon@brecon.co.uk (Simon Cozens) + Subject: [PATCH] Eliminate tr///[CU][CU] + Date: 23 Jun 2000 11:05:40 GMT + Message-ID: + + doc typo fix + Subject: [PATCH] documentation typo in lib/Pod/Usage.pm + From: Ian Phillipps + Date: Fri, 23 Jun 2000 10:40:58 +0100 + Message-ID: <20000623104058.A22791@homer.diplex.co.uk> + Branch: maint-5.6/perl + !> doop.c embed.pl lib/Pod/Usage.pm pod/perlop.pod toke.c utf8.c +____________________________________________________________________________ +[ 7342] By: gsar on 2000/10/16 08:28:08 + Log: integrate change#6217 from cfgperl (in part) + + Rename the fdpid locking and integrate with Sarathy. + Branch: maint-5.6/perl + !> Configure config_h.SH doio.c embed.h embed.pl embedvar.h + !> global.sym gv.c intrpvar.h objXSUB.h perl.c perlapi.h pp.c + !> pp_ctl.c proto.h sv.h util.c util.h vmesa/vmesa.c + !> win32/win32.c +____________________________________________________________________________ +[ 7341] By: gsar on 2000/10/16 08:23:39 + Log: integrate changes#6214..6216 from mainline + + @_ can't have junk in it even in the non-USE_ITHREADS case because + caller() wants to populate @DB::args with it (causes a coredump + in Carp::confess()) + + tweak comment about @DB::args + + be more optimal about clearing @_ + Branch: maint-5.6/perl + !> av.h cop.h pp_ctl.c t/op/runlevel.t +____________________________________________________________________________ +[ 7340] By: gsar on 2000/10/16 08:20:37 + Log: integrate changes#6207..6210 from cfgperl + + Subject: [PATCH 5.6.0] Threadsafe patches + From: Dan Sugalski + To: perl5-porters@perl.org + Date: Mon, 08 May 2000 18:08:13 -0400 + Message-Id: <4.3.1.0.20000508180729.02182de0@24.8.96.48> + + Regen headers for #6207. + + Lock PL_fdpid against race conditions, based on: + Subject: [PATCH 5.6.0]subprocess fixup for threads + From: Dan Sugalski + To: perl5-porters@perl.org + Date: Tue, 11 Apr 2000 17:02:32 -0400 + Message-Id: <4.3.0.20000411170218.01d2f580@24.8.96.48> + + Mopup for #6207 and #6209. + Branch: maint-5.6/perl + !> doio.c embed.h embed.pl global.sym gv.c intrpvar.h objXSUB.h + !> perl.c pp.c pp_ctl.c proto.h sv.h util.c vmesa/vmesa.c + !> win32/win32.c +____________________________________________________________________________ +[ 7339] By: gsar on 2000/10/16 08:14:34 + Log: integrate change#6203 from cfgperl + + perldiag should refer to perlos2.pod not README.os2 + Branch: maint-5.6/perl + !> pod/perldiag.pod +____________________________________________________________________________ +[ 7338] By: gsar on 2000/10/16 08:11:42 + Log: integrate change#6201 from mainline + + Perl_eval_pv() leaks 4 bytes every time it is called because it + does a PUSHMARK that's never ever POPMARKed; in general, only + Perl_call_[sp]v() need a PUSHMARK for incoming arguments; + Perl_eval_[sp]v() don't because they don't take any incoming + arguments (this leak has been around since the original version + of perl_eval_pv() in 5.003_97e) + Branch: maint-5.6/perl + !> perl.c +____________________________________________________________________________ +[ 7337] By: gsar on 2000/10/16 08:08:47 + Log: integrate changes#6197..6200 from cfgperl + + Subject: [ID 20000602.005] [PATCH]5.6.0 (DOC) tiny change to perlsyn.pod + From: John Borwick + Date: Fri, 2 Jun 2000 14:35:03 -0400 (EDT) + Message-Id: + + Subject: [PATCH 5.6.0]VMS fixups so we can build with MULTIPLICITY + From: Dan Sugalski + To: vmsperl@perl.org, perl5-porters@perl.org + Date: Fri, 02 Jun 2000 16:00:41 -0400 + Message-Id: <4.3.2.7.0.20000602155951.01f02b20@24.8.96.48> + Message-Id: <4.3.2.7.0.20000602164011.01ec8c30@24.8.96.48> + + Subject: [PATCH 5.6.0]Make perl's malloc work on VMS + From: Dan Sugalski + To: perl5-porters@perl.org, vmsperl@perl.org + Date: Fri, 02 Jun 2000 17:30:51 -0400 + Message-Id: <4.3.2.7.0.20000602173021.01f03570@24.8.96.48> + + Update to cperl-mode.el 4.31 from + ftp://ftp.math.ohio-state.edu/pub/users/ilya/cperl-mode.el + Subject: A couple of notes + From: Ilya Zakharevich + To: Mailing list Perl5 + Date: Sat, 3 Jun 2000 23:33:32 -0400 + Message-ID: <20000603233332.A6790@monk.mps.ohio-state.edu> + Branch: maint-5.6/perl + !> emacs/cperl-mode.el embed.h embed.pl embedvar.h + !> ext/POSIX/POSIX.xs global.sym objXSUB.h perlapi.c perlapi.h + !> pod/perlapi.pod pod/perlintern.pod pod/perlsyn.pod proto.h + !> vms/descrip_mms.template vms/gen_shrfls.pl vms/vms.c + !> vms/vmsish.h +____________________________________________________________________________ +[ 7336] By: gsar on 2000/10/16 08:03:46 + Log: integrate changes#6194,6195 from mainline + + fix small eval"" memory leaks under USE_ITHREADS + + fix yet another eval"" leak under USE_ITHREADS + Branch: maint-5.6/perl + !> cop.h embed.h embed.pl objXSUB.h op.c perl.c perlapi.c perly.c + !> perly_c.diff pp_ctl.c proto.h scope.c scope.h sv.c toke.c + !> vms/perly_c.vms +____________________________________________________________________________ +[ 7335] By: gsar on 2000/10/16 08:02:15 + Log: integrate changes#6190,6191 from mainline + + submit missing embed.pl change + + vec() loses numericalness (modified version of patch suggested + by Robin Barker) + Branch: maint-5.6/perl + !> doop.c embed.pl t/op/vec.t +____________________________________________________________________________ +[ 7334] By: gsar on 2000/10/16 08:01:03 + Log: integrate change#6189 from mainline + + counting tr/// corrupts later operation (from M.J.T Guy) + Branch: maint-5.6/perl + !> doop.c t/op/tr.t +____________________________________________________________________________ +[ 7333] By: gsar on 2000/10/16 07:59:07 + Log: integrate changes#6183..6188 from mainline + + SelfLoader can lose $@ in AUTOLOAD() (from Nicholas Clark + ) + + tweak for change#6127 + + remove incorrect documentation about implicit split to @_ in + list context, which never really worked in perl 5 (from + M.J.T. Guy) + + further qualify references to "alphanumeric" (from Wolfgang Laun + ) + + replace pod2latex with the one in Pod-LaTeX v0.52 from CPAN + (from Tim Jenness ) + + h2xs tweaks + Branch: maint-5.6/perl + +> lib/Pod/LaTeX.pm t/lib/selfloader.t + !> AUTHORS MAINTAIN MANIFEST ext/Devel/Peek/Peek.pm handy.h + !> lib/SelfLoader.pm perl.c pod/perlapi.pod pod/perldata.pod + !> pod/perlfaq6.pod pod/perlfaq9.pod pod/perlfunc.pod + !> pod/perllocale.pod pod/perlre.pod pod/perltrap.pod + !> pod/pod2latex.PL utils/h2xs.PL +____________________________________________________________________________ +[ 7332] By: gsar on 2000/10/16 07:53:52 + Log: integrate change#6179 from mainline + + buggy modulus on UVs introduced by change#3378 (resulted in + 4063328477 % 65535 amounting to 27406, instead of 27407) + Branch: maint-5.6/perl + !> pp.c t/op/arith.t +____________________________________________________________________________ +[ 7331] By: gsar on 2000/10/16 07:52:49 + Log: integrate changes#6176,6177,6178,6182 from cfgperl + + Single-quoted utf8 patch from Simon Cozens. + + Substitution utf8 patch from Simon Cozens. + + Be cleaner. + + Be Cleaner Part Deux. + Branch: maint-5.6/perl + !> Makefile.SH pp_hot.c toke.c +____________________________________________________________________________ +[ 7330] By: gsar on 2000/10/16 07:41:36 + Log: integrate change#6172 from mainline + + fix buggy multiline matching of C<"a\nxb\n" =~ /(?!\A)x/m> + (from Ilya Zakharevich) + Branch: maint-5.6/perl + !> regexec.c t/op/re_tests +____________________________________________________________________________ +[ 7329] By: gsar on 2000/10/16 07:40:25 + Log: integrate change#6171 from mainline + + scalar() doesn't force scalar context when used in void context + (from Simon Cozens) + Branch: maint-5.6/perl + !> op.c t/op/wantarray.t +____________________________________________________________________________ +[ 7328] By: gsar on 2000/10/16 07:39:33 + Log: integrate change#6170 from mainline + + change#6142 needs tweaks to tests to work where there's no + symlink() (from Helmut Jarausch ) + Branch: maint-5.6/perl + !> t/lib/filefind.t +____________________________________________________________________________ +[ 7327] By: gsar on 2000/10/16 07:35:34 + Log: integrate changes#6166..6168 from cfgperl + + Introduce HAS_GETESPWNAM, HAS_GETPRPWNAM, and I_PROT + in case somebody wants to write an extension for more + shadow database interfaces. + + tweak todo + + Tweak NV_PRESERVES_UV*, vms/subconfigure.com left untouched. + Branch: maint-5.6/perl + !> Configure Porting/Glossary Porting/config.sh Porting/config_H + !> Todo-5.6 config_h.SH epoc/config.sh perl.h pp_sys.c toke.c + !> vms/subconfigure.com vos/config.def vos/config.h vos/config.pl + !> vos/config_h.SH_orig win32/config.bc win32/config.gc + !> win32/config.vc win32/config_H.bc win32/config_H.gc + !> win32/config_H.vc win32/config_h.PL win32/config_sh.PL +____________________________________________________________________________ +[ 7326] By: gsar on 2000/10/16 07:29:05 + Log: integrate changes#6157,6159..6161,6164 from cfgperl + + Regen Configure to jive with #6149. + + Upgrade to File::Temp 0.08 from Tim Jenness via CPAN. + + Changes for the File::Temp 0.08 (change #6159) test suite + to fit better into the Perl distribution test framework. + + Add autogeneration of perlmodlib.pod and the new perlnewmod.pod, + both from Simon Cozens. + + detypo + Branch: maint-5.6/perl + +> pod/perlmodlib.PL pod/perlnewmod.pod + !> AUTHORS Configure MAINTAIN MANIFEST config_h.SH + !> lib/File/Temp.pm pod/Makefile pod/perl.pod pod/perlmodlib.pod + !> pod/perltoc.pod t/lib/ftmp-mktemp.t t/lib/ftmp-posix.t + !> t/lib/ftmp-security.t t/lib/ftmp-tempfile.t +____________________________________________________________________________ +[ 7325] By: gsar on 2000/10/16 07:25:13 + Log: integrate change#6158 from vmsperl + + Add fallback to tmpfile for use in cases where user's relying on + ACLs on SYS$SCRATCH to permit file creation. (based on Charles + Lane's patch) + Branch: maint-5.6/perl + !> vms/vms.c vms/vmsish.h +____________________________________________________________________________ +[ 7324] By: gsar on 2000/10/16 07:20:50 + Log: integrate changes#6153..6155 from mainline + + prettier Test::Harness output on failed tests (from Nicholas Clark + ) + + avoid type mismatch warning + + small bug in change#6144; remove random \xA0 character that snuck + in via change#6145 + Branch: maint-5.6/perl + !> lib/AutoSplit.pm lib/ExtUtils/xsubpp lib/Test/Harness.pm + !> perl.c +____________________________________________________________________________ +[ 7323] By: gsar on 2000/10/16 07:18:47 + Log: integrate changes#6151,6152 from mainline + + fix accidental pessimization in RE optimizer (from Ilya Zakharevich) + + cosmetic fixups of RE debug output (from Ilya Zakharevich) + Branch: maint-5.6/perl + !> regexec.c +____________________________________________________________________________ +[ 7322] By: gsar on 2000/10/16 07:17:25 + Log: integrate changes#6146..6150 from mainline + + doc typo + + add a make entry to Config.pm so "perl -V:make" works on VMS + (from Peter Prymmer) + + close open file before chmod() (from Rocco Caputo ) + + OS/2 tweaks for usethreads build (from Rocco Caputo + ) + + perlrequick.pod updates (from Mark Kvale ) + Branch: maint-5.6/perl + !> Configure hints/os2.sh lib/ExtUtils/MM_Unix.pm lib/warnings.pm + !> makedef.pl os2/Makefile.SHs os2/OS2/REXX/t/rx_dllld.t + !> os2/OS2/REXX/t/rx_objcall.t os2/OS2/REXX/t/rx_tievar.t + !> os2/OS2/REXX/t/rx_tieydb.t os2/os2.c os2/os2ish.h perl.c + !> pod/perlrequick.pod util.c vms/subconfigure.com warnings.h + !> warnings.pl x2p/a2p.h +____________________________________________________________________________ +[ 7321] By: gsar on 2000/10/16 07:14:02 + Log: integrate changes#6143..6145 from mainline + + MacOS support, part 1 (from Matthias Neeracher + ) + + MacOS support, part 2: make AutoSplit use File::Spec instead + of assuming Unixisms; *UNTESTED on Unix* (from Matthias Neeracher + ) + + make xsubpp skip embedded pod (from Matthias Neeracher + ) + Branch: maint-5.6/perl + +> ext/DynaLoader/dl_mac.xs + !> MANIFEST ext/DB_File/Makefile.PL ext/NDBM_File/Makefile.PL + !> ext/POSIX/POSIX.xs lib/AutoSplit.pm lib/ExtUtils/MakeMaker.pm + !> lib/ExtUtils/xsubpp mg.c perl.c perlsfio.h pod/perlfaq4.pod + !> pp_ctl.c proto.h toke.c util.c util.h +____________________________________________________________________________ +[ 7320] By: gsar on 2000/10/16 07:12:13 + Log: integrate changes#6141,6142 from mainline + + BSD/OS (bsdi) hints update by Timur I. Bakeyev and Todd C. Miller, + forwarded by Peter Seebach from the bsdi-users mailing list. + p5p Message-Id: <200005280543.AAA24519@guild.plethora.net> + + File::Find fails to chdir when chasing symlinks (from + Helmut Jarausch ) + Branch: maint-5.6/perl + !> hints/bsdos.sh lib/File/Find.pm t/lib/filefind.t +____________________________________________________________________________ +[ 7319] By: gsar on 2000/10/16 07:04:30 + Log: integrate change#6139 from mainline + + revise mktables.PL for bugs and newness in Unicode 3.0 + (from James Bence ) + Branch: maint-5.6/perl + +> (branch 30 files) + !> (integrate 49 files) +____________________________________________________________________________ +[ 7318] By: gsar on 2000/10/16 07:01:01 + Log: integrate changes#6137,6138 from mainline + + fix bogus redeclaration warning for "our" variables in different + scopes + + add note about the handling of negative indices to tied arrays + (from Michael G Schwern ) + Branch: maint-5.6/perl + !> op.c pod/perltie.pod t/pragma/strict-vars +____________________________________________________________________________ +[ 7317] By: gsar on 2000/10/16 06:58:46 + Log: integrate changes#6127..6136 from mainline + + call_method(...,G_EVAL) can longjmp() out if the method probing + failed (from Gisle Aas) + + new perlxstut example for passing/returning refs to arrays + (from David Lowe ) + + VMS test harness tweak (from Jesper Naur ) + + fix places that mean C<"word" character> but say C + + avoid warnings in POSIX.pm (from Barrie Slaymaker) + + warnings::enabled() doesn't fall back to looking at $^W if + caller isn't using lexical warnings (from Paul Marquess) + + elide bogus test in change#6132 + + make Test::Harness use wait.h/WCOREDUMP if available + (from Ben Tilly ) + + enable Test::Harness to dynamically determine column width etc. + (from Rob Napier ) + + random pod typos (from Peter Scott ) + Branch: maint-5.6/perl + !> cop.h ext/Devel/Peek/Peek.pm ext/POSIX/POSIX.pm + !> lib/Test/Harness.pm perl.c pod/perldebguts.pod + !> pod/perlfunc.pod pod/perlre.pod pod/perlretut.pod + !> pod/perlxstut.pod pp_ctl.c t/pragma/warn/9enabled vms/test.com +____________________________________________________________________________ +[ 7316] By: gsar on 2000/10/16 06:53:23 + Log: integrate change#6126 from mainline + + change#2879 broke rvalue autovivification of magicals such as + ${$num} (reworked variant of patch suggested by Simon Cozens) + Branch: maint-5.6/perl + !> embed.h embed.pl gv.c pod/perlapi.pod pod/perlintern.pod pp.c + !> pp_hot.c proto.h t/op/gv.t +____________________________________________________________________________ +[ 7315] By: gsar on 2000/10/16 06:51:38 + Log: integrate changes#6123,6125 from mainline + + clarify gotcha with #line directives (from Rocco Caputo + ) + + enable propagating exception objects via Perl_croak() in XS code + (from Gisle Aas) + Branch: maint-5.6/perl + !> pod/perldebug.pod pod/perlsyn.pod util.c +____________________________________________________________________________ +[ 7314] By: gsar on 2000/10/16 06:49:28 + Log: integrate change#6122 from mainline + + downgrade fatal error on C<"foo@nosucharray.com"> to optional + warning (from Mark-Jason Dominus) + Branch: maint-5.6/perl + !> lib/ExtUtils/typemap pod/perldelta.pod pod/perlsub.pod + !> pod/perltrap.pod t/base/lex.t t/pragma/strict-vars + !> t/pragma/strict.t t/pragma/warn/toke t/pragma/warnings.t + !> toke.c +____________________________________________________________________________ +[ 7313] By: gsar on 2000/10/16 06:46:54 + Log: integrate changes#6112..6121 from vmsperl + + Check for existence of file before trying to delete + + Ugly workaround for version-specific RTL error + + Urk -- undo previous removal of vmsish 'exit' change + + Add bounds checking for several strings (Charles Lane) + + Miscellaneous cosmetic fixes (Charles Lane) + + Treat sockets as special in sys(read|write) (Charles Lane et al.) + + Regularize distinction between RMS$_DNF and RMS$_DIR (Craig Berry) + Flatten case labels in switch statements uniformly (Charles Bailey) + + Quiet error messages in vmsish.t (Charles Lane) + + Add missing escape (Charles Lane) + + Allow eliminate_macros() and fixpath() to handle space-delimited + lists (based on fixes by Craig Berry) + Branch: maint-5.6/perl + !> lib/ExtUtils/MM_VMS.pm lib/File/Spec/VMS.pm t/op/lex_assign.t + !> vms/ext/vmsish.pm vms/ext/vmsish.t vms/test.com vms/vms.c + !> vms/vmsish.h +____________________________________________________________________________ +[ 7312] By: gsar on 2000/10/16 06:41:18 + Log: integrate changes#6107,6110 from cfgperl + + Tweak the todo list. + + todo tweak + Branch: maint-5.6/perl + !> Todo-5.6 +____________________________________________________________________________ +[ 7311] By: gsar on 2000/10/16 06:38:38 + Log: integrate changes#6104,6108 from mainline + + PL_sys_intern was being initialized too late on windows + + reenable fake signal handling on Windows, bugs and all + Branch: maint-5.6/perl + !> embed.h embed.pl global.sym makedef.pl mg.c objXSUB.h perl.c + !> perl.h perlapi.c pod/perlapi.pod proto.h win32/perlhost.h + !> win32/win32.c +____________________________________________________________________________ +[ 7310] By: gsar on 2000/10/16 06:36:03 + Log: integrate changes#6095,6097..6103 from cfgperl + + Introduce NV_PRESERVED_BITS. Not yet used anywhere but + might be useful in future. + + Add a note about possible compilation problems from Allen Smith. + + Add a note about other, yet unsupported, shadow password APIs. + + Tweaks for the cc bugs from Allen Smith. + + More compilation tweakery from Allen Smith. + + Hints and test tweaks for Unicos. + + The test suite tweak in #6101 wasn't quite right. + + Test tweaking for Unicos continues. + Branch: maint-5.6/perl + !> Configure Porting/Glossary Porting/config.sh Porting/config_H + !> config_h.SH hints/irix_6.sh hints/unicos.sh pp_sys.c t/lib/b.t + !> t/lib/complex.t t/op/64bitint.t +____________________________________________________________________________ +[ 7309] By: gsar on 2000/10/16 06:29:41 + Log: integrate changes#6093,6094 from mainline + + fork() failure to create pseudo process sets errno=EAGAIN and returns + undef on windows (from Clinton Pierce ) + + cygwin update (from Eric Fifer ) + Branch: maint-5.6/perl + !> README.cygwin cygwin/Makefile.SHs cygwin/cygwin.c + !> hints/cygwin.sh pp_sys.c sv.c win32/perlhost.h +____________________________________________________________________________ +[ 7308] By: gsar on 2000/10/16 06:27:29 + Log: integrate change#6092 from cfgperl + + Regen perltoc with the fixed buildtoc. + Branch: maint-5.6/perl + !> pod/perltoc.pod +____________________________________________________________________________ +[ 7307] By: gsar on 2000/10/16 06:26:40 + Log: integrate changes#6089,6090 from mainline + + buildtoc tweak to fix newline lossage + + concat doesn't preserve utf8-ness, and doesn't invalidate + [NI]OK; added tests for both + Branch: maint-5.6/perl + !> perl.c pod/buildtoc pp_hot.c sv.c t/op/substr.t +____________________________________________________________________________ +[ 7306] By: gsar on 2000/10/16 06:24:05 + Log: integrate change#6088 from cfgperl + + Remove HAS_SETSPENT, HAS_GETSPENT, HAS_ENDSPENT, + because we do not use those. The HAS_GETSPNAM remains, + though, because we still do use that. + Branch: maint-5.6/perl + !> Configure Porting/Glossary Porting/config.sh Porting/config_H + !> config_h.SH epoc/config.sh hints/machten.sh pod/perltoc.pod + !> pp_sys.c vms/subconfigure.com vos/config.def vos/config.h + !> vos/config_h.SH_orig win32/config.bc win32/config.gc + !> win32/config.vc win32/config_H.bc win32/config_H.gc + !> win32/config_H.vc win32/config_h.PL win32/config_sh.PL +____________________________________________________________________________ +[ 7305] By: gsar on 2000/10/16 06:15:52 + Log: integrate changes#6084,6085,6087 from mainline + + substr() does not preserve utf8-ness (from Stefan Eissing + ); added tests + + repeat operator (x) doesn't preserve utf8-ness + + reverse() and quotemeta() weren't preserving utf8-ness; add tests + Branch: maint-5.6/perl + !> pp.c sv.c t/op/quotemeta.t t/op/substr.t toke.c +____________________________________________________________________________ +[ 7304] By: gsar on 2000/10/16 06:13:10 + Log: integrate changes#6077..6083 from mainline + + avoid warnings in diagnostics.pm; pod tweaks (from Peter Prymmer + and Tom Phoenix) + + workaround for CRT bug in chdir() (from Charles Lane, via + Peter Prymmer) + + remove outdated kludge in Carp (NULLs are permitted in diagnostics + now) + + add File::Temp v0.08 from CPAN, with small tweaks to testsuite + (from Tim Jenness ) + + better default perlbug categories for ok reports (from Richard Foley) + + peek.t non-portable to ithreads + + note about undocumented caller() return value (from M.J.T. Guy); + yet another peek.t tweak + Branch: maint-5.6/perl + +> lib/File/Temp.pm t/lib/ftmp-mktemp.t t/lib/ftmp-posix.t + +> t/lib/ftmp-security.t t/lib/ftmp-tempfile.t + !> AUTHORS MAINTAIN MANIFEST iperlsys.h lib/Carp/Heavy.pm + !> lib/diagnostics.pm pod/perlfunc.pod pod/perlrun.pod + !> pod/perltie.pod t/lib/peek.t utils/perlbug.PL vms/vms.c + !> vms/vmsish.h +____________________________________________________________________________ +[ 7303] By: gsar on 2000/10/16 06:03:18 + Log: integrate changes#6011,6016,6033,6035..6039,6047..6052,6054..6059, + 6073..6075 from cfgperl (pp_sys.c manually merged due to conflicts) + + &HUGE_VAL is not defined, it exists. + + Do not warn that an infinity does not look like a number. + + Rewrite the pwent/spent logic to be a little bit more clearer. + + Continue on the pwent/spent case. + + Correct Freudian slip. + + Use HUGE_VALL if applicable. + + pwent/spent #ifdef imbalance. + + Infinite problems. + + Call getspnam() only iff needd. + + Test both the scalar and list contexts. + + Use setxxent()/endxxent(). + + Complex tweakery. + + Unicos hint tweak. + + Be more forgiving in POSIX about HUGE_VALL. + + Detypo. + + The search of infinity continues, this time simplified. + + The logic of choosing strtol/strtoul/strtoll/strtoull was wrong + in natively 64-bit platforms where a long is a quad (no need + for long longs). Also added bias for IVs. + + Complex tweaks. + + Introduce t/lib/peek.t. + + Make the test more portable. + Branch: maint-5.6/perl + +> t/lib/peek.t + ! pp_sys.c + !> MANIFEST ext/POSIX/POSIX.xs hints/unicos.sh + !> lib/Math/Complex.pm sv.c t/lib/complex.t t/op/grent.t + !> t/op/pwent.t toke.c util.c +____________________________________________________________________________ +[ 7302] By: gsar on 2000/10/16 05:03:37 + Log: integrate changes#6066..6071 from mainline + + s/END/CHECK/ + + replace direct call to sighandler() with (*PL_sighandlerp)() + + note about values() + + File::Spec compatibility update (from Barrie Slaymaker + ) + + remove misleading comment (from M.J.T. Guy) + + misformatted perllocal.pod (from Tim Jenness + ) + Branch: maint-5.6/perl + !> lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_Win32.pm + !> lib/File/Spec.pm lib/File/Spec/Mac.pm lib/File/Spec/Unix.pm + !> lib/File/Spec/VMS.pm lib/File/Spec/Win32.pm perl.c + !> pod/perlfunc.pod t/lib/anydbm.t win32/win32.c +____________________________________________________________________________ +[ 7301] By: gsar on 2000/10/16 05:00:08 + Log: integrate changes#6061..6063 from mainline + + change#5921 neglected to make eq honor "use bytes" + + additional tests for utf8.t + + tokeq() could read unallocated field in argument + Branch: maint-5.6/perl + !> sv.c t/pragma/utf8.t toke.c +____________________________________________________________________________ +[ 7300] By: gsar on 2000/10/16 04:56:54 + Log: integrate changes#6046,6048,6057,6058 from mainline + + libscheck has insufficient checks for n32 libs (from + Albert Chin-A-Young ) + + add note about how $( doesn't interpolate in REs (from + Philip Newton ) + + fix broken parsing of /\x{ab}/ + + printf(...) should be PerlIO_printf(PerlIO_stdout(), ...) + (spotted by Donald Kinzer ) + Branch: maint-5.6/perl + !> hints/irix_6.sh perl.c pod/perlop.pod regcomp.c + !> t/pragma/utf8.t +____________________________________________________________________________ +[ 7299] By: gsar on 2000/10/16 04:52:50 + Log: integrate change#6044 from mainline + + change#3798 broke the meaning of "\0_7_7", tr/\0_// etc.; fix it + such that underscores are only ignored in literal numbers, + "\x{...}", and hex/oct argument + Branch: maint-5.6/perl + !> perl.c pp.c regcomp.c t/op/oct.t toke.c util.c +____________________________________________________________________________ +[ 7298] By: gsar on 2000/10/16 04:50:53 + Log: integrate changes#6027..6043 from mainline + + podlators-1.02 update (from Russ Allbery) + + Pod::Man generates groff-incompatible macro definition (from + Tom Christiansen) + + add CGI.pm v2.66 (from Lincoln Stein) + + introduce @LAST_MATCH_START and @LAST_MATCH_END, English aliases + for @- and @+ (from Johan Vromans) + + small nits in diagnostics.pm (from Robin Barker) + + whitespace adjustments + + missing files in MANIFEST + + cpio 2.4.2 on Linux creates directories in 0700 mode, adjust makerel + to compensate + + remove outdated perltrap entry (from Peter Scott ) + + perlretut revisions (from Mark Kvale ) + Branch: maint-5.6/perl + +> lib/CGI/Util.pm t/lib/cgi-pretty.t + !> MANIFEST Porting/makerel lib/CGI.pm lib/CGI/Carp.pm + !> lib/CGI/Cookie.pm lib/CGI/Pretty.pm lib/CGI/Push.pm + !> lib/English.pm lib/Pod/Man.pm lib/Pod/Text.pm + !> lib/diagnostics.pm pod/perldiag.pod pod/perlretut.pod + !> pod/perltrap.pod pod/perlvar.pod pp_sys.c t/lib/cgi-function.t + !> t/lib/cgi-html.t t/lib/cgi-request.t +____________________________________________________________________________ +[ 7297] By: gsar on 2000/10/16 04:44:30 + Log: integrate change#6025 from mainline + + Is{Alnum,Alpha,Word} don't match titlecase + TODO: IsSpace is defined recursively! + (both spotted by Larry) + Branch: maint-5.6/perl + !> lib/unicode/Is/Alnum.pl lib/unicode/Is/Alpha.pl + !> lib/unicode/Is/Word.pl lib/unicode/mktables.PL +____________________________________________________________________________ +[ 7296] By: gsar on 2000/10/16 04:39:30 + Log: integrate change#6023 from mainline + + debugger stomps on $. (from M.J.T. Guy) + Branch: maint-5.6/perl + !> lib/perl5db.pl +____________________________________________________________________________ +[ 7295] By: gsar on 2000/10/16 04:38:02 + Log: integrate change#6022 from mainline + + unbalanced LEAVE after perl_clone(...,0) (from Doug MacEachern) + Branch: maint-5.6/perl + !> sv.c +____________________________________________________________________________ +[ 7294] By: gsar on 2000/10/16 04:37:05 + Log: integrate changes#6018..6021 from mainline + + make lib/syslog.t portable to systems that don't have _PATH_LOG, + make _PATH_LOG() return "" if unavailable + + windows portability tweaks + + test tweak + + remove Win2K issue in pod (fixed by change#6020) + Branch: maint-5.6/perl + !> README.win32 ext/File/Glob/Glob.pm ext/Sys/Syslog/Syslog.pm + !> ext/Sys/Syslog/Syslog.xs pod/perldelta.pod t/lib/b.t + !> t/lib/open3.t t/lib/syslog.t win32/win32.h +____________________________________________________________________________ +[ 7293] By: gsar on 2000/10/16 04:20:00 + Log: integrate changes#6013..6015 from mainline + + tweak change#5945 to display correct switch name in diagnostic + + glob() loading File::Glob behind the scenes may cause syntax errors + + tweak test for portability + Branch: maint-5.6/perl + !> op.c perl.c pod/perldiag.pod t/lib/b.t +____________________________________________________________________________ +[ 7292] By: gsar on 2000/10/16 04:18:11 + Log: integrate changes#6005..6010 from mainline, cfgperl + + perldoc might fail via "use blib" (from Hugo van der Sanden) + + Regen Configure. + + note about compile failures and END blocks (from M.J.T. Guy) + + VMS config tweak (from Craig A. Berry ) + + (change#6009 integrated earlier in change#7255) + + clarify note about shadow password support (from + gellyfish@gellyfish.com) + Branch: maint-5.6/perl + !> Configure Porting/Glossary Porting/config.sh Porting/config_H + !> config_h.SH installperl pod/perldelta.pod pod/perlfunc.pod + !> pod/perlmod.pod utils/perldoc.PL vms/subconfigure.com +____________________________________________________________________________ +[ 7291] By: gsar on 2000/10/16 04:12:03 + Log: integrate changes#6002,6003 from mainline + + destructive sv_setsv() can lose UV-ness from source, causing + numeric promotions/comparisons to fail to do the right thing + + allow REG_EXPAND_SZ keys in Windows registry (from + John Clayton ) + Branch: maint-5.6/perl + !> sv.c win32/win32.c +____________________________________________________________________________ +[ 7290] By: gsar on 2000/10/16 04:10:19 + Log: integrate change#6001 from mainline + + support additional library locations via $Config{otherlibdirs} + (from Andy Dougherty) + Branch: maint-5.6/perl + !> Configure INSTALL Porting/Glossary Porting/config.sh + !> Porting/config_H config_h.SH epoc/config.sh perl.c + !> vms/subconfigure.com vos/config.def vos/config_h.SH_orig + !> win32/config.bc win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 7289] By: gsar on 2000/10/16 04:08:28 + Log: integrate change#5999 from mainline + + fix line renumbering bug in C + Branch: maint-5.6/perl + !> t/pragma/warn/toke toke.c +____________________________________________________________________________ +[ 7288] By: gsar on 2000/10/16 04:07:01 + Log: integrate changes#5997,5998 from cfgperl + + Preserve $!. + + Try to get "Inf" by using &POSIX::HUGE_VAL in sprintf. + Branch: maint-5.6/perl + !> lib/Math/Complex.pm +____________________________________________________________________________ +[ 7287] By: gsar on 2000/10/16 04:04:37 + Log: integrate change#5995 from mainline + + fixes for bugs in C (from Paul Marquess) + Branch: maint-5.6/perl + !> mg.c t/pragma/warn/7fatal warnings.h warnings.pl +____________________________________________________________________________ +[ 7286] By: gsar on 2000/10/16 04:03:21 + Log: integrate change#5994 from mainline + + fix for missed accounting for null byte in pack("Z",...) (from + M.J.T. Guy) + Branch: maint-5.6/perl + !> pp.c t/op/pack.t +____________________________________________________________________________ +[ 7285] By: gsar on 2000/10/16 04:02:11 + Log: integrate changes#5989..5993 from mainline + + qw(a\\b) must be parsed like 'a\\b', i.e., backslash escapes + itself and no other (from Tom Hughes) + + use $ENV{LIB} to search for libs under Visual C compiler + on Windows (from Jochen Wiedmann ) + + posix-bc patches (from Dorner Thomas ) + + pod nit (from Simon Cozens) + + various minor tweaks seen on p5p + Branch: maint-5.6/perl + !> README.posix-bc hints/posix-bc.sh lib/ExtUtils/Liblist.pm + !> lib/perl5db.pl pod/perlipc.pod pod/perlop.pod pod/perlvar.pod + !> t/op/array.t toke.c +____________________________________________________________________________ +[ 7284] By: gsar on 2000/10/16 03:59:00 + Log: integrate changes#5978..5988 from mainline + + sync version numbers in File::Spec with the ones on CPAN + (from Barrie Slaymaker) + + under useithreads, constant pad entries could inadvertantly be + shared across threads (from Eric Blood ); + added Eric's test case to testsuite + + allow Configure -S to run non-interactively (spotted by Greg Hudson + ) + + rename File::Glob::glob() to File::Glob::bsd_glob() to avoid + prototype mismatch with CORE::glob(); update pod and tests to + suit (File::Glob::glob() is still available for backward + compatibility, but should be considered deprecated) + + avoid error in IO::Socket::INET when given an unknown service name + with a port number (from Brian Raven ) + + numeric conversion of non-number in change#3378 tramples on + OOK offset, causing segfaults + + attributes::reftype() doesn't work on tied argument + + forked child may not exit correctly if it failed to open + /dev/console (from Graham Barr) + + add regular expressions tutorial and quick-start guide (from + Mark Kvale ) + + B::Bytecode tweaks (from Simon Cozens ) + + s/HTMLSCRIPTPOD/HTMLSCRIPTPODS/ (from Paul Sharpe + ) + Branch: maint-5.6/perl + +> pod/perlrequick.pod pod/perlretut.pod + !> AUTHORS Configure MAINTAIN MANIFEST ext/B/B/Bytecode.pm + !> ext/B/B/Disassembler.pm ext/File/Glob/Glob.pm + !> ext/IO/lib/IO/Socket/INET.pm ext/Sys/Syslog/Syslog.pm + !> lib/ExtUtils/MakeMaker.pm lib/File/Spec/Functions.pm + !> lib/File/Spec/Mac.pm lib/File/Spec/OS2.pm + !> lib/File/Spec/Unix.pm lib/File/Spec/VMS.pm + !> lib/File/Spec/Win32.pm op.c sv.c t/lib/glob-basic.t + !> t/lib/glob-case.t t/lib/glob-taint.t t/op/misc.t xsutils.c +____________________________________________________________________________ +[ 7283] By: gsar on 2000/10/16 03:52:14 + Log: integrate change#5977 from mainline + + autoquote barewords followed by newline and arrow properly + (variant of fix suggested by Rick Delaney and M.J.T. Guy) + Branch: maint-5.6/perl + !> t/pragma/warn/toke toke.c +____________________________________________________________________________ +[ 7282] By: gsar on 2000/10/16 03:50:48 + Log: integrate change#5976 from mainline + + DB_File v1.73 update (from Paul Marquess) + Branch: maint-5.6/perl + !> ext/DB_File/Changes ext/DB_File/DB_File.pm + !> ext/DB_File/DB_File.xs ext/DB_File/version.c +____________________________________________________________________________ +[ 7281] By: gsar on 2000/10/16 03:49:14 + Log: integrate change#5975 from mainline + + allow sort() reentrancy (variant of patch suggested by + Hugo van der Sanden) + Branch: maint-5.6/perl + !> pp_ctl.c t/op/sort.t +____________________________________________________________________________ +[ 7280] By: gsar on 2000/10/16 03:48:22 + Log: integrate change#5974 from mainline + + change#4197 somehow missed initializing PL_errors, meaning + syntax error queueing wasn't working outside eval"" at all; + also fixed eval"" to localize PL_error_count, so that compile-time + eval's don't clobber the error state of the outer context + Branch: maint-5.6/perl + !> lib/Math/Complex.pm perl.c pp_ctl.c t/pragma/warn/op + !> t/pragma/warn/toke +____________________________________________________________________________ +[ 7279] By: gsar on 2000/10/16 03:46:21 + Log: integrate change#5973 from mainline + + fix for failure to match $foo =~ /(?i)/ (from Ilya Zakharevich) + Branch: maint-5.6/perl + !> regcomp.c regexec.c t/op/re_tests +____________________________________________________________________________ +[ 7278] By: gsar on 2000/10/16 03:44:54 + Log: integrate change#5971 from cfgperl + + Unicos tweaks from Mark P. Lutz. + Branch: maint-5.6/perl + !> hints/unicos.sh lib/Math/Complex.pm +____________________________________________________________________________ +[ 7277] By: gsar on 2000/10/16 03:42:59 + Log: integrate changes#5966..5970 from mainline + + add testsuite for B backends, fix bug in B::Deparse (from + Simon Cozens ) + + improved docs on the warn_uninit diagnostic (from David Glasser + and Simon Cozens) + + tolerate spaces in group names in test on solaris (from David Boyce + ) + + fix Sys::Syslog breakage on domain sockets (from Tom Hughes) + + Data::Dumper fumbles negative numbers on 32-bit platforms where + IV is >32bits + Branch: maint-5.6/perl + +> t/lib/b.t t/lib/syslog.t + !> MANIFEST ext/B/B/Deparse.pm ext/B/B/Stash.pm + !> ext/Data/Dumper/Dumper.xs ext/Sys/Syslog/Syslog.pm + !> pod/perldiag.pod t/lib/dumper.t t/op/groups.t +____________________________________________________________________________ +[ 7276] By: gsar on 2000/10/16 03:39:30 + Log: integrate change#5965 from mainline + + avoid "will not stay shared" warnings for our variables (from + Robin Barker) + Branch: maint-5.6/perl + !> op.c t/pragma/warn/op +____________________________________________________________________________ +[ 7275] By: gsar on 2000/10/16 03:38:18 + Log: integrate change#5964 from mainline + + reformat to 72 columns (again) + Branch: maint-5.6/perl + !> pod/perldiag.pod +____________________________________________________________________________ +[ 7274] By: gsar on 2000/10/16 03:36:58 + Log: integrate change#5963 from mainline + + patch from Larry to make (\&) prototype work; added tests for + the same + Branch: maint-5.6/perl + !> op.c t/comp/proto.t +____________________________________________________________________________ +[ 7273] By: gsar on 2000/10/16 03:35:51 + Log: integrate changes#5956..5962 from mainline + + better diagnostics on failed tests (from Ilya Zakharevich) + + pod nits (from A. C. Yardley ) + + change#3569 deleted some essential code, revert; avoid use of + atexit() to make DynaLoader work properly on AIX under mod_perl + (from Jens-Uwe Mager ) + + doubled words in pods (from Simon Cozens + ) + + better INSTALL notes on Solaris issues (from Dominic Dunlop) + + recognize our, CHECK and INIT in cperl-mode (from Doug MacEachern) + + updated README.hpux (from Jeff Okamoto) + Branch: maint-5.6/perl + !> INSTALL README.hpux emacs/cperl-mode.el + !> ext/DynaLoader/dl_aix.xs pod/perldebguts.pod pod/perldelta.pod + !> pod/perlfaq5.pod pod/perlfork.pod pod/perlfunc.pod + !> pod/perlipc.pod pod/perllexwarn.pod pod/perllocale.pod + !> pod/perlmod.pod pod/perlmodlib.pod pod/perlnumber.pod + !> pod/perlopentut.pod pod/perltodo.pod pod/perltootc.pod + !> t/op/lex_assign.t +____________________________________________________________________________ +[ 7272] By: gsar on 2000/10/16 03:31:22 + Log: integrate change#5955 from mainline + + longstanding bug exposed by change#3307: sort arguments weren't + compiled with the right wantarray context (ensuing runtime lookup + via block_gimme() was getting the incidental context of the + sort() itself) + Branch: maint-5.6/perl + !> op.c t/op/sort.t +____________________________________________________________________________ +[ 7271] By: gsar on 2000/10/16 03:29:11 + Log: integrate changes#5933,5935,5940..5944,5946,5951,5952 from cfgperl + branch + + Flatten the cpp jungle doing the nosuid checking. + + Do not assume sign propagation. (from M.J.T. Guy) + + Various Unicos 10.0.0.6 fixes. (from Mark Lutz) + + Add HAS_FREXPL, HAS_ISNAN, HAS_ISNANL, and HAS_MODFL. + Now pp_ncmp() returns undef is either operand is a NaN. + + On second thoughts frexp() does have two arguments. + + Document that tr() is not tr(1). + + Be more robust on "extreme" (large absolute value) + arguments. Originally reported by Daniel Connelly + as a problem with asinh() on large negative arguments, + asinh() used to bail out because an argument to log() + ended up being zero. Ilya Zakharevich proposed using + Taylor's series in such cases, which for such large + arguments is a very good approximation. + + Undo "use integer" addition from 64bitint as it seems + to break most of the subtests in Digital UNIX; + Unicos needs to find another way. + Branch: maint-5.6/perl + !> (integrate 29 files) +____________________________________________________________________________ +[ 7270] By: gsar on 2000/10/16 03:09:44 + Log: integrate changes#5948,5949,5950 from mainline + + typo in vars.pm that leads to cryptic message (from Piotr + Piatkowski ) + + make perldoc use the pod2man from the same version (from + M.J.T. Guy) + + reformat perldiag to avoid long lines + Branch: maint-5.6/perl + !> lib/vars.pm pod/perldiag.pod utils/perldoc.PL +____________________________________________________________________________ +[ 7269] By: gsar on 2000/10/16 03:05:54 + Log: integrate change#5947 from mainline + + use &dl_error rather than &dl_load_file as the guard for calling + boot_DynaLoader() (meant to fix dl_error() redefined warnings in + statically built perl) + Branch: maint-5.6/perl + !> ext/DynaLoader/DynaLoader_pm.PL ext/DynaLoader/XSLoader_pm.PL +____________________________________________________________________________ +[ 7268] By: gsar on 2000/10/16 03:04:48 + Log: integrate change#5945 from mainline + + make module name mandatory after -M switch; reorder perldiag + alphabetically (from Mark-Jason Dominus) + Branch: maint-5.6/perl + !> perl.c pod/perldiag.pod +____________________________________________________________________________ +[ 7267] By: gsar on 2000/10/16 03:03:01 + Log: integrate change#5939 from mainline + + more pod nits (from Larry Virden) + Branch: maint-5.6/perl + !> README.win32 pod/perlsub.pod pod/perlsyn.pod + !> pod/perlthrtut.pod pod/perltoc.pod pod/perltodo.pod + !> pod/perlxs.pod pod/perlxstut.pod vms/perlvms.pod +____________________________________________________________________________ +[ 7266] By: gsar on 2000/10/16 03:01:39 + Log: integrate change#5938 from mainline + + Consolidated B::Deparse fixes (from Stephen McCamant) + Branch: maint-5.6/perl + !> ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 7265] By: gsar on 2000/10/16 03:00:43 + Log: integrate change#5936 from mainline + + additional tests for change#7263 (from Paul Marquess) + Branch: maint-5.6/perl + !> t/pragma/warn/2use t/pragma/warn/3both t/pragma/warn/4lint + !> t/pragma/warn/5nolint t/pragma/warn/6default +____________________________________________________________________________ +[ 7264] By: gsar on 2000/10/16 02:58:34 + Log: integrate change#5934 from mainline + + propagate lexical warnings from surrounding scope correctly + within string eval() (from Paul Marquess) + Branch: maint-5.6/perl + !> pp_ctl.c t/pragma/warn/pp_ctl +____________________________________________________________________________ +[ 7263] By: gsar on 2000/10/16 02:56:53 + Log: integrate change#5932 from mainline + + add rsignal(), whichsig() and do_join() to public API list + (mod_perl uses them to good advantage) + Branch: maint-5.6/perl + !> embed.pl global.sym objXSUB.h perlapi.c proto.h +____________________________________________________________________________ +[ 7262] By: gsar on 2000/10/16 02:55:53 + Log: integrate change#5931 from mainline + + fix RE brokenness on refs/overloaded things (from Ilya Zakharevich) + Branch: maint-5.6/perl + !> pp_hot.c regexec.c t/op/pat.t +____________________________________________________________________________ +[ 7261] By: gsar on 2000/10/16 02:55:01 + Log: integrate change#5930 from mainline + + small os390 tweaks (from Peter Prymmer) + Branch: maint-5.6/perl + !> config_h.SH makedepend.SH +____________________________________________________________________________ +[ 7260] By: gsar on 2000/10/16 02:54:10 + Log: integrate change#5929 from mainline + + pod nits + Branch: maint-5.6/perl + !> pod/perlguts.pod +____________________________________________________________________________ +[ 7259] By: gsar on 2000/10/16 02:52:55 + Log: integrate change#5927 from mainline + + arrange for next() to resume at the unstack op rather than the + loop conditional, so that scope cleanup happens correctly + (from Stephen McCamant) + Branch: maint-5.6/perl + !> op.c pp_ctl.c t/op/misc.t +____________________________________________________________________________ +[ 7258] By: gsar on 2000/10/16 02:51:38 + Log: integrate change#5926 from mainline + + on windows, reserve 16M of stack rather than 128M (allows more + threads to run concurrently) + Branch: maint-5.6/perl + !> win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 7257] By: gsar on 2000/10/16 02:50:37 + Log: integrate change#5925 from mainline + + POSIX-BC tweak (from Ignasi Roca ) + Branch: maint-5.6/perl + !> toke.c +____________________________________________________________________________ +[ 7256] By: gsar on 2000/10/16 02:49:36 + Log: integrate change#5924 from mainline + + avoid using uninitialized memory in require version check + Branch: maint-5.6/perl + !> pp_ctl.c universal.c +____________________________________________________________________________ +[ 7255] By: gsar on 2000/10/16 02:48:03 + Log: integrate changes#5923,5928,6009 from mainline + + IO::Poll bugs fixed (from Lincoln Stein ) + Branch: maint-5.6/perl + !> ext/IO/lib/IO/Poll.pm t/lib/io_poll.t +____________________________________________________________________________ +[ 7254] By: gsar on 2000/10/16 02:44:46 + Log: integrate change#5922 from mainline + + commentary about IoTYPE() (from Nathan Torkington) + Branch: maint-5.6/perl + !> sv.h +____________________________________________________________________________ +[ 7253] By: gsar on 2000/10/16 02:43:49 + Log: integrate change#5921 from mainline + + make eq unicode-aware (from Gisle Aas); fix bogus tests revealed + Branch: maint-5.6/perl + !> sv.c t/lib/charnames.t t/pragma/utf8.t +____________________________________________________________________________ +[ 7252] By: gsar on 2000/10/16 02:42:31 + Log: integrate change#5920 from mainline + + Larry's fix for buggy propagation of utf8-ness in join(); add test + Branch: maint-5.6/perl + !> doop.c t/op/ver.t +____________________________________________________________________________ +[ 7251] By: gsar on 2000/10/16 02:41:14 + Log: integrate changes#5915..5919 from mainline + + various (pod tweaks &c) + Branch: maint-5.6/perl + !> (integrate 33 files) +____________________________________________________________________________ +[ 7250] By: gsar on 2000/10/16 02:38:16 + Log: integrate change#5914 from mainline + + caller() wasn't returning the right number of elements for + eval {...} + Branch: maint-5.6/perl + !> pp_ctl.c t/pragma/warn/9enabled +____________________________________________________________________________ +[ 7249] By: gsar on 2000/10/16 02:37:02 + Log: integrate change#5913 from mainline + + pod nit: $yday range for localtime/gmtime is 0..364 not 1..365 + (from Mark-Jason Dominus) + Branch: maint-5.6/perl + !> pod/perlfunc.pod +____________________________________________________________________________ +[ 7248] By: gsar on 2000/10/16 02:35:58 + Log: integrate change#5912 from mainline + + fix totally broken caching in UNIVERSAL::isa() (from + Nick Ing-Simmons) + Branch: maint-5.6/perl + !> t/op/universal.t universal.c +____________________________________________________________________________ +[ 7247] By: gsar on 2000/10/16 02:34:27 + Log: integrate changes#5910,5911 from mainline + + typo in pod + + add linebreak properties from unicode/LineBrk.txt (from + Dave Hartnoll ) + Branch: maint-5.6/perl + +> (branch 29 files) + !> ext/Thread/Thread.pm lib/unicode/mktables.PL +____________________________________________________________________________ +[ 7246] By: gsar on 2000/10/16 02:33:29 + Log: integrate change#5909 from mainline + + mode argument to do_binmode() should be file mode, not boolean + Branch: maint-5.6/perl + !> pp_sys.c +____________________________________________________________________________ +[ 7245] By: gsar on 2000/10/16 02:31:04 + Log: integrate change#5908 from mainline + + introduce illegal symbols into null package so that + gv_fetchpv(...,TRUE) always returns a valid GV even when the + symbol is trapped by strictures (avoids coredumps) + Branch: maint-5.6/perl + !> embedvar.h gv.c intrpvar.h perl.c perlapi.h + !> t/pragma/strict-vars +____________________________________________________________________________ +[ 7242] By: gsar on 2000/10/16 02:26:51 + Log: integrate changes#5905,5906,5907,6064 from mainline + + printf/sprintf didn't get quad types right under use64bitint + Branch: maint-5.6/perl + !> pp_sys.c sv.c t/op/64bitint.t +____________________________________________________________________________ +[ 5902] By: gsar on 2000/03/28 01:59:14 + Log: create maint-5.6 branch + Branch: maint-5.6/perl + +> (branch 1611 files) +____________________________________________________________________________ +[ 5900] By: gsar on 2000/03/23 05:42:43 + Log: three guesses on what this is :-) + Branch: perl + ! Changes -------------- Version v5.6.0 @@ -664,7 +7913,7 @@ ____________________________________________________________________________ ____________________________________________________________________________ [ 5802] By: jhi on 2000/03/18 17:11:07 Log: Configure nits: rewording from Sarathy (aka #5796), - and installation directories patch from Robin Parker. + and installation directories patch from Robin Barker. Branch: cfgperl ! Configure Porting/Glossary Porting/config.sh Porting/config_H ! config_h.SH vos/config.h vos/config_h.SH_orig @@ -2841,7 +10090,7 @@ ____________________________________________________________________________ ____________________________________________________________________________ [ 5440] By: jhi on 2000/03/02 17:48:15 Log: Confusion over uselargefiles.cbu and uselfs.cbu (the first one - is the correct one), spotted by Robin Parker. + is the correct one), spotted by Robin Barker. Branch: cfgperl ! Configure config_h.SH hints/aix.sh hints/hpux.sh Branch: metaconfig/U/perl @@ -12365,7 +19614,7 @@ ____________________________________________________________________________ ____________________________________________________________________________ [ 4045] By: jhi on 1999/08/29 15:18:38 Log: Fix scalar gmtime (and localtime) in quad environments, - bug reported by Robin Parker. + bug reported by Robin Barker. From: Robin Barker To: jhi@iki.fi @@ -13319,7 +20568,7 @@ ____________________________________________________________________________ [ 3914] By: jhi on 1999/08/03 21:11:11 Log: The op/filetest.t failed subtest 7 if testing as root. - From: =?iso-8859-1?Q?Fran=E7ois=20D=E9sarm=E9nien?= + From: François Désarménien To: perl5-porters@perl.org Subject: [ID 19990727.039] Not OK: perl 5.00558 on i386-sco 3.2v5.0.4 Date: Tue, 27 Jul 1999 22:54:05 +0200 diff --git a/contrib/perl5/Changes5.004 b/contrib/perl5/Changes5.004 index d0601663ecf5..2d578b43ab7c 100644 --- a/contrib/perl5/Changes5.004 +++ b/contrib/perl5/Changes5.004 @@ -8031,7 +8031,7 @@ This release is beta candidate #5: Our last, best hope for a beta. From: Chip Salzenberg Files: pp_hot.c - Title: "Fix grep() with refs in array context" + Title: "Fix grep() with refs in list context" From: Chip Salzenberg Files: pp.c diff --git a/contrib/perl5/Configure b/contrib/perl5/Configure index 3e7ac45a8660..05ce5ea64732 100755 --- a/contrib/perl5/Configure +++ b/contrib/perl5/Configure @@ -20,10 +20,10 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Wed Mar 22 19:13:31 EET 2000 [metaconfig 3.0 PL70] -# (with additional metaconfig patches by perlbug@perl.com) +# Generated on Tue Mar 13 05:21:04 EET 2001 [metaconfig 3.0 PL70] +# (with additional metaconfig patches by perlbug@perl.org) -cat >/tmp/c1$$ <c1$$ </tmp/c2$$ <c2$$ <&4 @@ -1739,6 +1781,43 @@ persist across sessions for $package. You may safely delete it if you wish. EOF +xversion=`awk '/define[ ]+PERL_VERSION/ {print $3}' $rsrc/patchlevel.h` +case "$usedevel" in +$define|true|[yY]*) ;; +*) case "$xversion" in + *[13579]) + cat >&4 <&4 "Okay, continuing." ;; + *) echo >&4 "Okay, bye." + exit 1 + ;; + esac + ;; + esac + ;; +esac + : general instructions needman=true firsttime=true @@ -1801,7 +1880,7 @@ Much effort has been expended to ensure that this shell script will run on any Unix system. If despite that it blows up on yours, your best bet is to edit Configure and run it again. If you can't run Configure for some reason, you'll have to generate a config.sh file by hand. Whatever problems you -have, let me (perlbug@perl.com) know how I blew it. +have, let me (perlbug@perl.org) know how I blew it. This installation script affects things in two ways: @@ -1887,6 +1966,7 @@ uniq trylist=" Mcc ar +bison byacc cpp csh @@ -1985,6 +2065,7 @@ test) ;; *) if `sh -c "PATH= test true" >/dev/null 2>&1`; then + echo "Using the test built into your sh." echo "Using the test built into your sh." test=test _test=test @@ -2022,6 +2103,66 @@ FOO ;; esac +cat <checkcc +$startsh +EOS +cat <<'EOSC' >>checkcc +case "$cc" in +'') ;; +*) $rm -f try try.* + $cat >try.c <&4 + despair=yes + trygcc=yes + case "$cc" in + *gcc*) trygcc=no ;; + esac + case "`$cc -v -c try.c 2>&1`" in + *gcc*) trygcc=no ;; + esac + if $test X"$trygcc" = Xyes; then + if gcc -o try -c try.c; then + echo " " + echo "You seem to have a working gcc, though." >&4 + rp="Would you like to use it?" + dflt=y + if $test -f myread; then + . ./myread + else + if $test -f UU/myread; then + . ./UU/myread + else + echo "Cannot find myread, sorry. Aborting." >&2 + exit 1 + fi + fi + case "$ans" in + [yY]*) cc=gcc; ccname=gcc; ccflags=''; despair=no ;; + esac + fi + fi + if $test X"$despair" = Xyes; then + $cat >&4 <&4 + $lns blurfl sym + if $test "X$issymlink" = X; then + sh -c "PATH= test -h sym" >/dev/null 2>&1 + if test $? = 0; then + issymlink="test -h" + fi + fi + if $test "X$issymlink" = X; then + if $test -h >/dev/null 2>&1; then + issymlink="$test -h" + echo "Your builtin 'test -h' may be broken, I'm using external '$test -h'." >&4 + fi + fi + if $test "X$issymlink" = X; then + if $test -L sym 2>/dev/null; then + issymlink="$test -L" + fi + fi + if $test "X$issymlink" != X; then + echo "You can test for symbolic links with '$issymlink'." >&4 + else + echo "I do not know how you can test for symbolic links." >&4 + fi + $rm -f blurfl sym + ;; +*) echo "No symbolic links, so not testing for their testing..." >&4 + ;; +esac +echo " " + + +case "$mksymlinks" in +$define|true|[yY]*) + case "$src" in + ''|'.') echo "Cannot create symlinks in the original directory." >&4 + exit 1 + ;; + *) case "$lns:$issymlink" in + *"ln -s:"*"test -"?) + echo "Creating the symbolic links..." >&4 + echo "(First creating the subdirectories...)" >&4 + cd .. + awk '{print $1}' $src/MANIFEST | grep / | sed 's:/[^/]*$::' | sort -u | while true; do + read directory + test -z "$directory" && break + mkdir -p $directory + done + # Sanity check 1. + if test ! -d t/base; then + echo "Failed to create the subdirectories. Aborting." >&4 + exit 1 + fi + echo "(Then creating the symlinks...)" >&4 + awk '{print $1}' $src/MANIFEST | while true; do + read filename + test -z "$filename" && break + if test -f $filename; then + if $issymlink $filename; then + rm -f $filename + fi + fi + if test -f $filename; then + echo "$filename already exists, not symlinking." + else + ln -s $src/$filename $filename + fi + done + # Sanity check 2. + if test ! -f t/base/cond.t; then + echo "Failed to create the symlinks. Aborting." >&4 + exit 1 + fi + cd UU + ;; + *) echo "(I cannot figure out how to do symbolic links, ignoring mksymlinks)." >&4 + ;; + esac + ;; + esac + ;; +esac + : see whether [:lower:] and [:upper:] are supported character classes echo " " case "`echo AbyZ | $tr '[:lower:]' '[:upper:]' 2>/dev/null`" in @@ -2136,7 +2364,10 @@ if test -f config.sh; then rp="I see a config.sh file. Shall I use it to set the defaults?" . UU/myread case "$ans" in - n*|N*) echo "OK, I'll ignore it."; mv config.sh config.sh.old;; + n*|N*) echo "OK, I'll ignore it." + mv config.sh config.sh.old + myuname="$newmyuname" + ;; *) echo "Fetching default answers from your old config.sh file..." >&4 tmp_n="$n" tmp_c="$c" @@ -2154,6 +2385,7 @@ if test -f config.sh; then ;; esac fi +. ./UU/checkcc if test ! -f config.sh; then $cat <&4 dflt='' : Half the following guesses are probably wrong... If you have better - : tests or hints, please send them to perlbug@perl.com + : tests or hints, please send them to perlbug@perl.org : The metaconfig authors would also appreciate a copy... $test -f /irix && osname=irix $test -f /xenix && osname=sco_xenix @@ -2300,6 +2532,7 @@ EOM esac ;; next*) osname=next ;; + nonstop-ux) osname=nonstopux ;; POSIX-BC | posix-bc ) osname=posix-bc osvers="$3" ;; @@ -2541,7 +2774,6 @@ cd UU ;; esac test "$override" && . ./optdef.sh -myuname="$newmyuname" : Restore computed paths for file in $loclist $trylist; do @@ -2702,6 +2934,19 @@ EOM ;; esac +case "$useithreads$use5005threads" in +"$define$define") + $cat >&4 <&4 -else - echo "Could not find manual pages in source form." >&4 -fi - -: see what memory models we can support -case "$models" in -'') - $cat >pdp11.c <<'EOP' -int main() { -#ifdef pdp11 - exit(0); -#else - exit(1); -#endif -} -EOP - ( cc -o pdp11 pdp11.c ) >/dev/null 2>&1 - if $test -f pdp11 && ./pdp11 2>/dev/null; then - dflt='unsplit split' - else - tans=`./loc . X /lib/small /lib/large /usr/lib/small /usr/lib/large /lib/medium /usr/lib/medium /lib/huge` - case "$tans" in - X) dflt='none';; - *) if $test -d /lib/small || $test -d /usr/lib/small; then - dflt='small' - else - dflt='' - fi - if $test -d /lib/medium || $test -d /usr/lib/medium; then - dflt="$dflt medium" - fi - if $test -d /lib/large || $test -d /usr/lib/large; then - dflt="$dflt large" - fi - if $test -d /lib/huge || $test -d /usr/lib/huge; then - dflt="$dflt huge" - fi - esac - fi;; -*) dflt="$models";; -esac -$cat </dev/null 2>&1 || \ - $contains '\-i' $sysman/cc.1 >/dev/null 2>&1; then - dflt='-i' - else - dflt='none' - fi;; - *) dflt="$split";; - esac - rp="What flag indicates separate I and D space?" - . ./myread - tans="$ans" - case "$tans" in - none) tans='';; - esac - split="$tans" - unsplit='';; -*large*|*small*|*medium*|*huge*) - case "$models" in - *large*) - case "$large" in - '') dflt='-Ml';; - *) dflt="$large";; - esac - rp="What flag indicates large model?" - . ./myread - tans="$ans" - case "$tans" in - none) tans=''; - esac - large="$tans";; - *) large='';; - esac - case "$models" in - *huge*) case "$huge" in - '') dflt='-Mh';; - *) dflt="$huge";; - esac - rp="What flag indicates huge model?" - . ./myread - tans="$ans" - case "$tans" in - none) tans=''; - esac - huge="$tans";; - *) huge="$large";; - esac - case "$models" in - *medium*) case "$medium" in - '') dflt='-Mm';; - *) dflt="$medium";; - esac - rp="What flag indicates medium model?" - . ./myread - tans="$ans" - case "$tans" in - none) tans=''; - esac - medium="$tans";; - *) medium="$large";; - esac - case "$models" in - *small*) case "$small" in - '') dflt='none';; - *) dflt="$small";; - esac - rp="What flag indicates small model?" - . ./myread - tans="$ans" - case "$tans" in - none) tans=''; - esac - small="$tans";; - *) small='';; - esac - ;; -*) - echo "Unrecognized memory models--you may have to edit Makefile.SH" >&4 - ;; -esac -$rm -f pdp11.* pdp11 - : make some quick guesses about what we are up against echo " " $echo $n "Hmm... $c" @@ -2939,7 +3020,7 @@ if test -f /osf_boot || $contains 'OSF/1' /usr/include/ctype.h >/dev/null 2>&1 then echo "Looks kind of like an OSF/1 system, but we'll see..." echo exit 0 >osf1 -elif test `echo abc | tr a-z A-Z` = Abc ; then +elif test `echo abc | $tr a-z A-Z` = Abc ; then xxx=`./loc addbib blurfl $pth` if $test -f $xxx; then echo "Looks kind of like a USG system with BSD features, but we'll see..." @@ -2978,12 +3059,15 @@ EOI ;; esac : Detect OS2. The p_ variable is set above in the Head.U unit. +: Note that this also -- wrongly -- detects e.g. dos-djgpp, which also uses +: semicolon as a patch separator case "$p_" in :) ;; *) $cat <<'EOI' I have the feeling something is not exactly right, however...don't tell me... lemme think...does HAL ring a bell?...no, of course, you're only running OS/2! +(Or you may be running DOS with DJGPP.) EOI echo exit 0 >os2 ;; @@ -3014,57 +3098,21 @@ chmod +x bsd usg v7 osf1 eunice xenix venix os2 $eunicefix bsd usg v7 osf1 eunice xenix venix os2 $rm -f foo -: see if we need a special compiler -echo " " -if ./usg; then - case "$cc" in - '') case "$Mcc" in - /*) dflt='Mcc';; - *) case "$large" in - -M*) dflt='cc';; - *) if $contains '\-M' $sysman/cc.1 >/dev/null 2>&1 ; then - if $contains '\-M' $sysman/cpp.1 >/dev/null 2>&1; then - dflt='cc' - else - dflt='cc -M' - fi - else - dflt='cc' - fi;; - esac;; - esac;; - *) dflt="$cc";; - esac - case "$dflt" in - *M*) $cat <<'EOM' -On some older systems the default C compiler will not resolve multiple global -references that happen to have the same name. On some such systems the "Mcc" -command may be used to force these to be resolved. On other systems a "cc -M" -command is required. (Note that the -M flag on other systems indicates a -memory model to use!) If you have the Gnu C compiler, you might wish to use -that instead. - -EOM - ;; - esac - rp="Use which C compiler?" - . ./myread - cc="$ans" -else - case "$cc" in - '') dflt=cc;; - *) dflt="$cc";; - esac - rp="Use which C compiler?" - . ./myread - cc="$ans" -fi +case "$cc" in +'') dflt=cc;; +*) dflt="$cc";; +esac +rp="Use which C compiler?" +. ./myread +cc="$ans" : Look for a hint-file generated 'call-back-unit'. Now that the : user has specified the compiler, we may need to set or change some : other defaults. if $test -f cc.cbu; then . ./cc.cbu fi +. ./checkcc + echo " " echo "Checking for GNU cc in disguise and/or its version number..." >&4 $cat >gccvers.c <&1|grep '/specs$'|sed "s!.*/[^-/]*-[^-/]*-\([^-/]*\)/$gccshortvers/specs!\1!"` + gccshortvers='' + case "$gccosandvers" in + $osname) gccosandvers='' ;; # linux gccs seem to have no linux osvers, grr + $osname$osvers) ;; # looking good + $osname*) cat <&4 -: decide how portable to be. Allow command line overrides. -case "$d_portable" in -"$undef") ;; -*) d_portable="$define" ;; -esac +*** WHOA THERE!!! *** -: set up shell script to do ~ expansion -cat >filexp <&2 - exit 1 - fi - case "\$1" in - */*) - echo \$dir/\`$expr x\$1 : '..[^/]*/\(.*\)'\` - ;; - *) - echo \$dir - ;; - esac - fi - ;; -*) - echo \$1 - ;; -esac -EOSS -chmod +x filexp -$eunicefix filexp + Your gcc has not been compiled for the exact release of + your operating system ($gccosandvers versus $osname$osvers). -: now set up to get a file name -cat <getfile -$startsh -EOS -cat <<'EOSC' >>getfile -tilde='' -fullpath='' -already='' -skip='' -none_ok='' -exp_file='' -nopath_ok='' -orig_rp="$rp" -orig_dflt="$dflt" -case "$gfpth" in -'') gfpth='.' ;; -esac + In general it is a good idea to keep gcc synchronized with + the operating system because otherwise serious problems + may ensue when trying to compile software, like Perl. -case "$fn" in -*\(*) - expr $fn : '.*(\(.*\)).*' | tr ',' $trnl >getfile.ok - fn=`echo $fn | sed 's/(.*)//'` - ;; -esac + I'm trying to be optimistic here, though, and will continue. + If later during the configuration and build icky compilation + problems appear (headerfile conflicts being the most common + manifestation), I suggest reinstalling the gcc to match + your operating system release. -case "$fn" in -*:*) - loc_file=`expr $fn : '.*:\(.*\)'` - fn=`expr $fn : '\(.*\):.*'` - ;; +EOM + ;; + *) gccosandvers='' ;; # failed to parse, better be silent + esac + ;; esac - -case "$fn" in -*~*) tilde=true;; -esac -case "$fn" in -*/*) fullpath=true;; -esac -case "$fn" in -*+*) skip=true;; -esac -case "$fn" in -*n*) none_ok=true;; -esac -case "$fn" in -*e*) exp_file=true;; -esac -case "$fn" in -*p*) nopath_ok=true;; -esac - -case "$fn" in -*f*) type='File';; -*d*) type='Directory';; -*l*) type='Locate';; -esac - -what="$type" -case "$what" in -Locate) what='File';; -esac - -case "$exp_file" in -'') - case "$d_portable" in - "$define") ;; - *) exp_file=true;; - esac - ;; -esac - -cd .. -while test "$type"; do - redo='' - rp="$orig_rp" - dflt="$orig_dflt" - case "$tilde" in - true) rp="$rp (~name ok)";; - esac - . UU/myread - if test -f UU/getfile.ok && \ - $contains "^$ans\$" UU/getfile.ok >/dev/null 2>&1 - then - value="$ans" - ansexp="$ans" - break - fi - case "$ans" in - none) - value='' - ansexp='' - case "$none_ok" in - true) type='';; - esac - ;; - *) - case "$tilde" in - '') value="$ans" - ansexp="$ans";; - *) - value=`UU/filexp $ans` - case $? in - 0) - if test "$ans" != "$value"; then - echo "(That expands to $value on this system.)" - fi - ;; - *) value="$ans";; - esac - ansexp="$value" - case "$exp_file" in - '') value="$ans";; - esac - ;; - esac - case "$fullpath" in - true) - case "$ansexp" in - /*) value="$ansexp" ;; - *) - redo=true - case "$already" in - true) - echo "I shall only accept a full path name, as in /bin/ls." >&4 - echo "Use a ! shell escape if you wish to check pathnames." >&4 - ;; - *) - echo "Please give a full path name, starting with slash." >&4 - case "$tilde" in - true) - echo "Note that using ~name is ok provided it expands well." >&4 - already=true - ;; - esac - esac - ;; - esac - ;; - esac - case "$redo" in - '') - case "$type" in - File) - for fp in $gfpth; do - if test "X$fp" = X.; then - pf="$ansexp" - else - pf="$fp/$ansexp" - fi - if test -f "$pf"; then - type='' - elif test -r "$pf" || (test -h "$pf") >/dev/null 2>&1 - then - echo "($value is not a plain file, but that's ok.)" - type='' - fi - if test X"$type" = X; then - value="$pf" - break - fi - done - ;; - Directory) - for fp in $gfpth; do - if test "X$fp" = X.; then - dir="$ans" - direxp="$ansexp" - else - dir="$fp/$ansexp" - direxp="$fp/$ansexp" - fi - if test -d "$direxp"; then - type='' - value="$dir" - break - fi - done - ;; - Locate) - if test -d "$ansexp"; then - echo "(Looking for $loc_file in directory $value.)" - value="$value/$loc_file" - ansexp="$ansexp/$loc_file" - fi - if test -f "$ansexp"; then - type='' - fi - case "$nopath_ok" in - true) case "$value" in - */*) ;; - *) echo "Assuming $value will be in people's path." - type='' - ;; - esac - ;; - esac - ;; - esac - - case "$skip" in - true) type=''; - esac - - case "$type" in - '') ;; - *) - if test "$fastread" = yes; then - dflt=y - else - dflt=n - fi - rp="$what $value doesn't exist. Use that name anyway?" - . UU/myread - dflt='' - case "$ans" in - y*) type='';; - *) echo " ";; - esac - ;; - esac - ;; - esac - ;; - esac -done -cd UU -ans="$value" -rp="$orig_rp" -dflt="$orig_dflt" -rm -f getfile.ok -test "X$gfpthkeep" != Xy && gfpth="" -EOSC - -: What should the include directory be ? -echo " " -$echo $n "Hmm... $c" -dflt='/usr/include' -incpath='' -mips_type='' -if $test -f /bin/mips && /bin/mips; then - echo "Looks like a MIPS system..." - $cat >usr.c <<'EOCP' -#ifdef SYSTYPE_BSD43 -/bsd43 -#endif -EOCP - if $cc -E usr.c > usr.out && $contains / usr.out >/dev/null 2>&1; then - dflt='/bsd43/usr/include' - incpath='/bsd43' - mips_type='BSD 4.3' - else - mips_type='System V' - fi - $rm -f usr.c usr.out - echo "and you're compiling with the $mips_type compiler and libraries." - xxx_prompt=y - echo "exit 0" >mips -else - echo "Doesn't look like a MIPS system." - xxx_prompt=n - echo "exit 1" >mips -fi -chmod +x mips -$eunicefix mips -case "$usrinc" in -'') ;; -*) dflt="$usrinc";; -esac -case "$xxx_prompt" in -y) fn=d/ - echo " " - rp='Where are the include files you want to use?' - . ./getfile - usrinc="$ans" - ;; -*) usrinc="$dflt" - ;; +case "$ccname" in +'') ccname="$cc" ;; esac : see how we invoke the C preprocessor @@ -3576,6 +3334,332 @@ case "$cppstdin" in esac $rm -f testcpp.c testcpp.out +: decide how portable to be. Allow command line overrides. +case "$d_portable" in +"$undef") ;; +*) d_portable="$define" ;; +esac + +: set up shell script to do ~ expansion +cat >filexp <&2 + exit 1 + fi + case "\$1" in + */*) + echo \$dir/\`$expr x\$1 : '..[^/]*/\(.*\)'\` + ;; + *) + echo \$dir + ;; + esac + fi + ;; +*) + echo \$1 + ;; +esac +EOSS +chmod +x filexp +$eunicefix filexp + +: now set up to get a file name +cat <getfile +$startsh +EOS +cat <<'EOSC' >>getfile +tilde='' +fullpath='' +already='' +skip='' +none_ok='' +exp_file='' +nopath_ok='' +orig_rp="$rp" +orig_dflt="$dflt" +case "$gfpth" in +'') gfpth='.' ;; +esac + +case "$fn" in +*\(*) + expr $fn : '.*(\(.*\)).*' | $tr ',' $trnl >getfile.ok + fn=`echo $fn | sed 's/(.*)//'` + ;; +esac + +case "$fn" in +*:*) + loc_file=`expr $fn : '.*:\(.*\)'` + fn=`expr $fn : '\(.*\):.*'` + ;; +esac + +case "$fn" in +*~*) tilde=true;; +esac +case "$fn" in +*/*) fullpath=true;; +esac +case "$fn" in +*+*) skip=true;; +esac +case "$fn" in +*n*) none_ok=true;; +esac +case "$fn" in +*e*) exp_file=true;; +esac +case "$fn" in +*p*) nopath_ok=true;; +esac + +case "$fn" in +*f*) type='File';; +*d*) type='Directory';; +*l*) type='Locate';; +esac + +what="$type" +case "$what" in +Locate) what='File';; +esac + +case "$exp_file" in +'') + case "$d_portable" in + "$define") ;; + *) exp_file=true;; + esac + ;; +esac + +cd .. +while test "$type"; do + redo='' + rp="$orig_rp" + dflt="$orig_dflt" + case "$tilde" in + true) rp="$rp (~name ok)";; + esac + . UU/myread + if test -f UU/getfile.ok && \ + $contains "^$ans\$" UU/getfile.ok >/dev/null 2>&1 + then + value="$ans" + ansexp="$ans" + break + fi + case "$ans" in + none) + value='' + ansexp='' + case "$none_ok" in + true) type='';; + esac + ;; + *) + case "$tilde" in + '') value="$ans" + ansexp="$ans";; + *) + value=`UU/filexp $ans` + case $? in + 0) + if test "$ans" != "$value"; then + echo "(That expands to $value on this system.)" + fi + ;; + *) value="$ans";; + esac + ansexp="$value" + case "$exp_file" in + '') value="$ans";; + esac + ;; + esac + case "$fullpath" in + true) + case "$ansexp" in + /*) value="$ansexp" ;; + [a-zA-Z]:/*) value="$ansexp" ;; + *) + redo=true + case "$already" in + true) + echo "I shall only accept a full path name, as in /bin/ls." >&4 + echo "Use a ! shell escape if you wish to check pathnames." >&4 + ;; + *) + echo "Please give a full path name, starting with slash." >&4 + case "$tilde" in + true) + echo "Note that using ~name is ok provided it expands well." >&4 + already=true + ;; + esac + esac + ;; + esac + ;; + esac + case "$redo" in + '') + case "$type" in + File) + for fp in $gfpth; do + if test "X$fp" = X.; then + pf="$ansexp" + else + pf="$fp/$ansexp" + fi + if test -f "$pf"; then + type='' + elif test -r "$pf" || (test -h "$pf") >/dev/null 2>&1 + then + echo "($value is not a plain file, but that's ok.)" + type='' + fi + if test X"$type" = X; then + value="$pf" + break + fi + done + ;; + Directory) + for fp in $gfpth; do + if test "X$fp" = X.; then + dir="$ans" + direxp="$ansexp" + else + dir="$fp/$ansexp" + direxp="$fp/$ansexp" + fi + if test -d "$direxp"; then + type='' + value="$dir" + break + fi + done + ;; + Locate) + if test -d "$ansexp"; then + echo "(Looking for $loc_file in directory $value.)" + value="$value/$loc_file" + ansexp="$ansexp/$loc_file" + fi + if test -f "$ansexp"; then + type='' + fi + case "$nopath_ok" in + true) case "$value" in + */*) ;; + *) echo "Assuming $value will be in people's path." + type='' + ;; + esac + ;; + esac + ;; + esac + + case "$skip" in + true) type=''; + esac + + case "$type" in + '') ;; + *) + if test "$fastread" = yes; then + dflt=y + else + dflt=n + fi + rp="$what $value doesn't exist. Use that name anyway?" + . UU/myread + dflt='' + case "$ans" in + y*) type='';; + *) echo " ";; + esac + ;; + esac + ;; + esac + ;; + esac +done +cd UU +ans="$value" +rp="$orig_rp" +dflt="$orig_dflt" +rm -f getfile.ok +test "X$gfpthkeep" != Xy && gfpth="" +EOSC + +: What should the include directory be ? +echo " " +$echo $n "Hmm... $c" +dflt='/usr/include' +incpath='' +mips_type='' +if $test -f /bin/mips && /bin/mips; then + echo "Looks like a MIPS system..." + $cat >usr.c <<'EOCP' +#ifdef SYSTYPE_BSD43 +/bsd43 +#endif +EOCP + if cc -E usr.c > usr.out && $contains / usr.out >/dev/null 2>&1; then + dflt='/bsd43/usr/include' + incpath='/bsd43' + mips_type='BSD 4.3' + else + mips_type='System V' + fi + $rm -f usr.c usr.out + echo "and you're compiling with the $mips_type compiler and libraries." + xxx_prompt=y + echo "exit 0" >mips +else + echo "Doesn't look like a MIPS system." + xxx_prompt=n + echo "exit 1" >mips +fi +chmod +x mips +$eunicefix mips +case "$usrinc" in +'') ;; +*) dflt="$usrinc";; +esac +case "$xxx_prompt" in +y) fn=d/ + echo " " + rp='Where are the include files you want to use?' + . ./getfile + usrinc="$ans" + ;; +*) usrinc="$dflt" + ;; +esac + : Set private lib path case "$plibpth" in '') if ./mips; then @@ -3882,8 +3966,8 @@ for thisincl in $inclwanted; do if $test -d $thisincl; then if $test x$thisincl != x$usrinc; then case "$dflt" in - *$thisincl*);; - *) dflt="$dflt -I$thisincl";; + *" -I$thisincl "*);; + *) dflt="$dflt -I$thisincl ";; esac fi fi @@ -3919,6 +4003,7 @@ esac case "$dflt" in ''|' ') dflt=none;; esac + $cat < try.c <<'EOF' #include int main() { printf("Ok\n"); exit(0); } EOF -set X $cc $optimize $ccflags -o try $ldflags try.c $libs +set X $cc -o try $optimize $ccflags $ldflags try.c $libs shift $cat >try.msg <<'EOM' I've tried to compile and run the following simple program: @@ -4070,8 +4155,8 @@ and I got the following output: EOM dflt=y -if sh -c "$cc $optimize $ccflags -o try $ldflags try.c $libs" >>try.msg 2>&1; then - if sh -c './try' >>try.msg 2>&1; then +if $sh -c "$cc -o try $optimize $ccflags $ldflags try.c $libs" >>try.msg 2>&1; then + if $sh -c './try' >>try.msg 2>&1; then xxx=`./try` case "$xxx" in "Ok") dflt=n ;; @@ -4182,12 +4267,12 @@ esac' compile=' mc_file=$1; shift; -$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs > /dev/null 2>&1;' +$cc -o ${mc_file} $optimize $ccflags $ldflags $* ${mc_file}.c $libs > /dev/null 2>&1;' : define a shorthand compile call for compilations that should be ok. compile_ok=' mc_file=$1; shift; -$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs;' +$cc -o ${mc_file} $optimize $ccflags $ldflags $* ${mc_file}.c $libs;' : check for lengths of integral types echo " " @@ -4592,6 +4677,601 @@ case "$use64bitall" in ;; esac +echo " " +echo "Checking for GNU C Library..." >&4 +cat >gnulibc.c < +int main() +{ +#ifdef __GLIBC__ + exit(0); +#else + exit(1); +#endif +} +EOM +set gnulibc +if eval $compile_ok && ./gnulibc; then + val="$define" + echo "You are using the GNU C Library" +else + val="$undef" + echo "You are not using the GNU C Library" +fi +$rm -f gnulibc* +set d_gnulibc +eval $setvar + +: see if nm is to be used to determine whether a symbol is defined or not +case "$usenm" in +'') + dflt='' + case "$d_gnulibc" in + "$define") + echo " " + echo "nm probably won't work on the GNU C Library." >&4 + dflt=n + ;; + esac + case "$dflt" in + '') + if $test "$osname" = aix -a ! -f /lib/syscalls.exp; then + echo " " + echo "Whoops! This is an AIX system without /lib/syscalls.exp!" >&4 + echo "'nm' won't be sufficient on this sytem." >&4 + dflt=n + fi + ;; + esac + case "$dflt" in + '') dflt=`$egrep 'inlibc|csym' $rsrc/Configure | wc -l 2>/dev/null` + if $test $dflt -gt 20; then + dflt=y + else + dflt=n + fi + ;; + esac + ;; +*) + case "$usenm" in + true|$define) dflt=y;; + *) dflt=n;; + esac + ;; +esac +$cat < /dev/null 2>&1; then + nm_so_opt='--dynamic' + fi + ;; + esac + ;; +esac + +case "$runnm" in +true) +: get list of predefined functions in a handy place +echo " " +case "$libc" in +'') libc=unknown + case "$libs" in + *-lc_s*) libc=`./loc libc_s$_a $libc $libpth` + esac + ;; +esac +libnames=''; +case "$libs" in +'') ;; +*) for thislib in $libs; do + case "$thislib" in + -lc|-lc_s) + : Handle C library specially below. + ;; + -l*) + thislib=`echo $thislib | $sed -e 's/^-l//'` + if try=`./loc lib$thislib.$so.'*' X $libpth`; $test -f "$try"; then + : + elif try=`./loc lib$thislib.$so X $libpth`; $test -f "$try"; then + : + elif try=`./loc lib$thislib$_a X $libpth`; $test -f "$try"; then + : + elif try=`./loc $thislib$_a X $libpth`; $test -f "$try"; then + : + elif try=`./loc lib$thislib X $libpth`; $test -f "$try"; then + : + elif try=`./loc $thislib X $libpth`; $test -f "$try"; then + : + elif try=`./loc Slib$thislib$_a X $xlibpth`; $test -f "$try"; then + : + else + try='' + fi + libnames="$libnames $try" + ;; + *) libnames="$libnames $thislib" ;; + esac + done + ;; +esac +xxx=normal +case "$libc" in +unknown) + set /lib/libc.$so + for xxx in $libpth; do + $test -r $1 || set $xxx/libc.$so + : The messy sed command sorts on library version numbers. + $test -r $1 || \ + set `echo blurfl; echo $xxx/libc.$so.[0-9]* | \ + tr ' ' $trnl | egrep -v '\.[A-Za-z]*$' | $sed -e ' + h + s/[0-9][0-9]*/0000&/g + s/0*\([0-9][0-9][0-9][0-9][0-9]\)/\1/g + G + s/\n/ /' | \ + $sort | $sed -e 's/^.* //'` + eval set \$$# + done + $test -r $1 || set /usr/ccs/lib/libc.$so + $test -r $1 || set /lib/libsys_s$_a + ;; +*) + set blurfl + ;; +esac +if $test -r "$1"; then + echo "Your (shared) C library seems to be in $1." + libc="$1" +elif $test -r /lib/libc && $test -r /lib/clib; then + echo "Your C library seems to be in both /lib/clib and /lib/libc." + xxx=apollo + libc='/lib/clib /lib/libc' + if $test -r /lib/syslib; then + echo "(Your math library is in /lib/syslib.)" + libc="$libc /lib/syslib" + fi +elif $test -r "$libc" || (test -h "$libc") >/dev/null 2>&1; then + echo "Your C library seems to be in $libc, as you said before." +elif $test -r $incpath/usr/lib/libc$_a; then + libc=$incpath/usr/lib/libc$_a; + echo "Your C library seems to be in $libc. That's fine." +elif $test -r /lib/libc$_a; then + libc=/lib/libc$_a; + echo "Your C library seems to be in $libc. You're normal." +else + if tans=`./loc libc$_a blurfl/dyick $libpth`; $test -r "$tans"; then + : + elif tans=`./loc libc blurfl/dyick $libpth`; $test -r "$tans"; then + libnames="$libnames "`./loc clib blurfl/dyick $libpth` + elif tans=`./loc clib blurfl/dyick $libpth`; $test -r "$tans"; then + : + elif tans=`./loc Slibc$_a blurfl/dyick $xlibpth`; $test -r "$tans"; then + : + elif tans=`./loc Mlibc$_a blurfl/dyick $xlibpth`; $test -r "$tans"; then + : + else + tans=`./loc Llibc$_a blurfl/dyick $xlibpth` + fi + if $test -r "$tans"; then + echo "Your C library seems to be in $tans, of all places." + libc=$tans + else + libc='blurfl' + fi +fi +if $test $xxx = apollo -o -r "$libc" || (test -h "$libc") >/dev/null 2>&1; then + dflt="$libc" + cat < libpath + cat >&4 < libnames +set X `cat libnames` +shift +xxx=files +case $# in 1) xxx=file; esac +echo "Extracting names from the following $xxx for later perusal:" >&4 +echo " " +$sed 's/^/ /' libnames >&4 +echo " " +$echo $n "This may take a while...$c" >&4 + +for file in $*; do + case $file in + *$so*) $nm $nm_so_opt $nm_opt $file 2>/dev/null;; + *) $nm $nm_opt $file 2>/dev/null;; + esac +done >libc.tmp + +$echo $n ".$c" +$grep fprintf libc.tmp > libc.ptf +xscan='eval "libc.list"; $echo $n ".$c" >&4' +xrun='eval "libc.list"; echo "done" >&4' +xxx='[ADTSIW]' +if com="$sed -n -e 's/__IO//' -e 's/^.* $xxx *_[_.]*//p' -e 's/^.* $xxx *//p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun +elif com="$sed -n -e 's/^__*//' -e 's/^\([a-zA-Z_0-9$]*\).*xtern.*/\1/p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun +elif com="$sed -n -e '/|UNDEF/d' -e '/FUNC..GL/s/^.*|__*//p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun +elif com="$sed -n -e 's/^.* D __*//p' -e 's/^.* D //p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun +elif com="$sed -n -e 's/^_//' -e 's/^\([a-zA-Z_0-9]*\).*xtern.*text.*/\1/p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun +elif com="$sed -n -e 's/^.*|FUNC |GLOB .*|//p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun +elif com="$grep '|' | $sed -n -e '/|COMMON/d' -e '/|DATA/d' \ + -e '/ file/d' -e 's/^\([^ ]*\).*/\1/p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun +elif com="$sed -n -e 's/^.*|FUNC |GLOB .*|//p' -e 's/^.*|FUNC |WEAK .*|//p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun +elif com="$sed -n -e 's/^__//' -e '/|Undef/d' -e '/|Proc/s/ .*//p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun +elif com="$sed -n -e 's/^.*|Proc .*|Text *| *//p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun +elif com="$sed -n -e '/Def. Text/s/.* \([^ ]*\)\$/\1/p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun +elif com="$sed -n -e 's/^[-0-9a-f ]*_\(.*\)=.*/\1/p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun +elif com="$sed -n -e 's/.*\.text n\ \ \ \.//p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun +elif com="sed -n -e 's/^__.*//' -e 's/[ ]*D[ ]*[0-9]*.*//p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun +else + $nm -p $* 2>/dev/null >libc.tmp + $grep fprintf libc.tmp > libc.ptf + if com="$sed -n -e 's/^.* [ADTSIW] *_[_.]*//p' -e 's/^.* [ADTSIW] //p'";\ + eval $xscan; $contains '^fprintf$' libc.list >/dev/null 2>&1 + then + nm_opt='-p' + eval $xrun + else + echo " " + echo "$nm didn't seem to work right. Trying $ar instead..." >&4 + com='' + if $ar t $libc > libc.tmp && $contains '^fprintf$' libc.tmp >/dev/null 2>&1; then + for thisname in $libnames $libc; do + $ar t $thisname >>libc.tmp + done + $sed -e "s/\\$_o\$//" < libc.tmp > libc.list + echo "Ok." >&4 + elif test "X$osname" = "Xos2" && $ar tv $libc > libc.tmp; then + # Repeat libc to extract forwarders to DLL entries too + for thisname in $libnames $libc; do + $ar tv $thisname >>libc.tmp + # Revision 50 of EMX has bug in $ar. + # it will not extract forwarders to DLL entries + # Use emximp which will extract exactly them. + emximp -o tmp.imp $thisname \ + 2>/dev/null && \ + $sed -e 's/^\([_a-zA-Z0-9]*\) .*$/\1/p' \ + < tmp.imp >>libc.tmp + $rm tmp.imp + done + $sed -e "s/\\$_o\$//" -e 's/^ \+//' < libc.tmp > libc.list + echo "Ok." >&4 + else + echo "$ar didn't seem to work right." >&4 + echo "Maybe this is a Cray...trying bld instead..." >&4 + if bld t $libc | $sed -e 's/.*\///' -e "s/\\$_o:.*\$//" > libc.list + then + for thisname in $libnames; do + bld t $libnames | \ + $sed -e 's/.*\///' -e "s/\\$_o:.*\$//" >>libc.list + $ar t $thisname >>libc.tmp + done + echo "Ok." >&4 + else + echo "That didn't work either. Giving up." >&4 + exit 1 + fi + fi + fi +fi +nm_extract="$com" +if $test -f /lib/syscalls.exp; then + echo " " + echo "Also extracting names from /lib/syscalls.exp for good ole AIX..." >&4 + $sed -n 's/^\([^ ]*\)[ ]*syscall[0-9]*$/\1/p' /lib/syscalls.exp >>libc.list +fi +;; +esac +$rm -f libnames libpath + +: is a C symbol defined? +csym='tlook=$1; +case "$3" in +-v) tf=libc.tmp; tc=""; tdc="";; +-a) tf=libc.tmp; tc="[0]"; tdc="[]";; +*) tlook="^$1\$"; tf=libc.list; tc="()"; tdc="()";; +esac; +tx=yes; +case "$reuseval-$4" in +true-) ;; +true-*) tx=no; eval "tval=\$$4"; case "$tval" in "") tx=yes;; esac;; +esac; +case "$tx" in +yes) + case "$runnm" in + true) + if $contains $tlook $tf >/dev/null 2>&1; + then tval=true; + else tval=false; + fi;; + *) + echo "int main() { extern short $1$tdc; printf(\"%hd\", $1$tc); }" > t.c; + if $cc -o t $optimize $ccflags $ldflags t.c $libs >/dev/null 2>&1; + then tval=true; + else tval=false; + fi; + $rm -f t t.c;; + esac;; +*) + case "$tval" in + $define) tval=true;; + *) tval=false;; + esac;; +esac; +eval "$2=$tval"' + +: define an is-in-libc? function +inlibc='echo " "; td=$define; tu=$undef; +sym=$1; var=$2; eval "was=\$$2"; +tx=yes; +case "$reuseval$was" in +true) ;; +true*) tx=no;; +esac; +case "$tx" in +yes) + set $sym tres -f; + eval $csym; + case "$tres" in + true) + echo "$sym() found." >&4; + case "$was" in $undef) . ./whoa; esac; eval "$var=\$td";; + *) + echo "$sym() NOT found." >&4; + case "$was" in $define) . ./whoa; esac; eval "$var=\$tu";; + esac;; +*) + case "$was" in + $define) echo "$sym() found." >&4;; + *) echo "$sym() NOT found." >&4;; + esac;; +esac' + +: see if sqrtl exists +set sqrtl d_sqrtl +eval $inlibc + +case "$ccflags" in +*-DUSE_LONG_DOUBLE*|*-DUSE_MORE_BITS*) uselongdouble="$define" ;; +esac + +case "$uselongdouble" in +$define|true|[yY]*) dflt='y';; +*) dflt='n';; +esac +cat <&4 + +*** You requested the use of long doubles but you do not seem to have +*** the mathematic functions for long doubles. I'm disabling the use +*** of long doubles. + +EOM + uselongdouble=$undef + ;; +esac + +: check for length of double +echo " " +case "$doublesize" in +'') + echo "Checking to see how big your double precision numbers are..." >&4 + $cat >try.c <<'EOCP' +#include +int main() +{ + printf("%d\n", (int)sizeof(double)); + exit(0); +} +EOCP + set try + if eval $compile_ok; then + doublesize=`./try` + echo "Your double is $doublesize bytes long." + else + dflt='8' + echo "(I can't seem to compile the test program. Guessing...)" + rp="What is the size of a double precision number (in bytes)?" + . ./myread + doublesize="$ans" + fi + ;; +esac +$rm -f try.c try + +: check for long doubles +echo " " +echo "Checking to see if you have long double..." >&4 +echo 'int main() { long double x = 7.0; }' > try.c +set try +if eval $compile; then + val="$define" + echo "You have long double." +else + val="$undef" + echo "You do not have long double." +fi +$rm try.* +set d_longdbl +eval $setvar + +: check for length of long double +case "${d_longdbl}${longdblsize}" in +$define) + echo " " + echo "Checking to see how big your long doubles are..." >&4 + $cat >try.c <<'EOCP' +#include +int main() +{ + printf("%d\n", sizeof(long double)); +} +EOCP + set try + set try + if eval $compile; then + longdblsize=`./try$exe_ext` + echo "Your long doubles are $longdblsize bytes long." + else + dflt='8' + echo " " + echo "(I can't seem to compile the test program. Guessing...)" >&4 + rp="What is the size of a long double (in bytes)?" + . ./myread + longdblsize="$ans" + fi + if $test "X$doublesize" = "X$longdblsize"; then + echo "(That isn't any different from an ordinary double.)" + fi + ;; +esac +$rm -f try.* try + : determine the architecture name echo " " if xxx=`./loc arch blurfl $pth`; $test -f "$xxx"; then @@ -4646,12 +5326,19 @@ $define) esac ;; esac -case "$use64bitint" in -$define) +case "$use64bitint$use64bitall" in +*"$define"*) case "$archname64" in '') + echo "This architecture is naturally 64-bit, not changing architecture name." >&4 ;; *) + case "$use64bitint" in + "$define") echo "64 bit integers selected." >&4 ;; + esac + case "$use64bitall" in + "$define") echo "Maximal 64 bitness selected." >&4 ;; + esac case "$archname" in *-$archname64*) echo "...and architecture name already has $archname64." >&4 ;; @@ -4662,6 +5349,37 @@ $define) ;; esac esac +case "$uselongdouble" in +$define) + echo "Long doubles selected." >&4 + case "$longdblsize" in + $doublesize) + "...but long doubles are equal to doubles, not changing architecture name." >&4 + ;; + *) + case "$archname" in + *-ld*) echo "...and architecture name already has -ld." >&4 + ;; + *) archname="$archname-ld" + echo "...setting architecture name to $archname." >&4 + ;; + esac + ;; + esac + ;; +esac +case "$useperlio" in +$define) + echo "Perlio selected." >&4 + case "$archname" in + *-perlio*) echo "...and architecture name already has -perlio." >&4 + ;; + *) archname="$archname-perlio" + echo "...setting architecture name to $archname." >&4 + ;; + esac + ;; +esac : determine root of directory hierarchy where package will be installed. case "$prefix" in @@ -4795,10 +5513,7 @@ else api_version=0 api_subversion=0 fi -$echo $n "(You have $package revision $revision" $c -$echo $n " patchlevel $patchlevel" $c -test 0 -eq "$subversion" || $echo $n " subversion $subversion" $c -echo ".)" +$echo "(You have $package version $patchlevel subversion $subversion.)" case "$osname" in dos|vms) : XXX Should be a Configure test for double-dots in filenames. @@ -5245,6 +5960,108 @@ echo "Your system uses $freetype free(), it would seem." >&4 $rm -f malloc.[co] $cat <&4 @@ -5446,90 +6298,18 @@ case "$perl5" in *) echo "Using $perl5." ;; esac -$cat < getverlist <> getverlist <<'EOPL' # Can't have leading @ because metaconfig interprets it as a command! ;@inc_version_list=(); -$stem=dirname($sitelib); # XXX Redo to do opendir/readdir? if (-d $stem) { chdir($stem); @@ -5582,6 +6362,13 @@ esac case "$dflt" in ''|' ') dflt=none ;; esac +case "$dflt" in +5.005) case "$bincompat5005" in + $define|true|[yY]*) ;; + *) dflt=none ;; + esac + ;; +esac $cat <<'EOM' In order to ease the process of upgrading, this version of perl @@ -5636,468 +6423,10 @@ fi set installusrbinperl eval $setvar -echo " " -echo "Checking for GNU C Library..." >&4 -cat >gnulibc.c < -int main() -{ -#ifdef __GLIBC__ - exit(0); -#else - exit(1); -#endif -} -EOM -set gnulibc -if eval $compile_ok && ./gnulibc; then - val="$define" - echo "You are using the GNU C Library" -else - val="$undef" - echo "You are not using the GNU C Library" -fi -$rm -f gnulibc* -set d_gnulibc -eval $setvar - -: see if nm is to be used to determine whether a symbol is defined or not -case "$usenm" in -'') - dflt='' - case "$d_gnulibc" in - "$define") - echo " " - echo "nm probably won't work on the GNU C Library." >&4 - dflt=n - ;; - esac - case "$dflt" in - '') - if $test "$osname" = aix -a ! -f /lib/syscalls.exp; then - echo " " - echo "Whoops! This is an AIX system without /lib/syscalls.exp!" >&4 - echo "'nm' won't be sufficient on this sytem." >&4 - dflt=n - fi - ;; - esac - case "$dflt" in - '') dflt=`$egrep 'inlibc|csym' $rsrc/Configure | wc -l 2>/dev/null` - if $test $dflt -gt 20; then - dflt=y - else - dflt=n - fi - ;; - esac - ;; -*) - case "$usenm" in - true|$define) dflt=y;; - *) dflt=n;; - esac - ;; -esac -$cat < /dev/null 2>&1; then - nm_so_opt='--dynamic' - fi - ;; - esac - ;; -esac - -case "$runnm" in -true) -: get list of predefined functions in a handy place -echo " " -case "$libc" in -'') libc=unknown - case "$libs" in - *-lc_s*) libc=`./loc libc_s$_a $libc $libpth` - esac - ;; -esac -libnames=''; -case "$libs" in -'') ;; -*) for thislib in $libs; do - case "$thislib" in - -lc|-lc_s) - : Handle C library specially below. - ;; - -l*) - thislib=`echo $thislib | $sed -e 's/^-l//'` - if try=`./loc lib$thislib.$so.'*' X $libpth`; $test -f "$try"; then - : - elif try=`./loc lib$thislib.$so X $libpth`; $test -f "$try"; then - : - elif try=`./loc lib$thislib$_a X $libpth`; $test -f "$try"; then - : - elif try=`./loc $thislib$_a X $libpth`; $test -f "$try"; then - : - elif try=`./loc lib$thislib X $libpth`; $test -f "$try"; then - : - elif try=`./loc $thislib X $libpth`; $test -f "$try"; then - : - elif try=`./loc Slib$thislib$_a X $xlibpth`; $test -f "$try"; then - : - else - try='' - fi - libnames="$libnames $try" - ;; - *) libnames="$libnames $thislib" ;; - esac - done - ;; -esac -xxx=normal -case "$libc" in -unknown) - set /lib/libc.$so - for xxx in $libpth; do - $test -r $1 || set $xxx/libc.$so - : The messy sed command sorts on library version numbers. - $test -r $1 || \ - set `echo blurfl; echo $xxx/libc.$so.[0-9]* | \ - tr ' ' $trnl | egrep -v '\.[A-Za-z]*$' | $sed -e ' - h - s/[0-9][0-9]*/0000&/g - s/0*\([0-9][0-9][0-9][0-9][0-9]\)/\1/g - G - s/\n/ /' | \ - sort | $sed -e 's/^.* //'` - eval set \$$# - done - $test -r $1 || set /usr/ccs/lib/libc.$so - $test -r $1 || set /lib/libsys_s$_a - ;; -*) - set blurfl - ;; -esac -if $test -r "$1"; then - echo "Your (shared) C library seems to be in $1." - libc="$1" -elif $test -r /lib/libc && $test -r /lib/clib; then - echo "Your C library seems to be in both /lib/clib and /lib/libc." - xxx=apollo - libc='/lib/clib /lib/libc' - if $test -r /lib/syslib; then - echo "(Your math library is in /lib/syslib.)" - libc="$libc /lib/syslib" - fi -elif $test -r "$libc" || (test -h "$libc") >/dev/null 2>&1; then - echo "Your C library seems to be in $libc, as you said before." -elif $test -r $incpath/usr/lib/libc$_a; then - libc=$incpath/usr/lib/libc$_a; - echo "Your C library seems to be in $libc. That's fine." -elif $test -r /lib/libc$_a; then - libc=/lib/libc$_a; - echo "Your C library seems to be in $libc. You're normal." -else - if tans=`./loc libc$_a blurfl/dyick $libpth`; $test -r "$tans"; then - : - elif tans=`./loc libc blurfl/dyick $libpth`; $test -r "$tans"; then - libnames="$libnames "`./loc clib blurfl/dyick $libpth` - elif tans=`./loc clib blurfl/dyick $libpth`; $test -r "$tans"; then - : - elif tans=`./loc Slibc$_a blurfl/dyick $xlibpth`; $test -r "$tans"; then - : - elif tans=`./loc Mlibc$_a blurfl/dyick $xlibpth`; $test -r "$tans"; then - : - else - tans=`./loc Llibc$_a blurfl/dyick $xlibpth` - fi - if $test -r "$tans"; then - echo "Your C library seems to be in $tans, of all places." - libc=$tans - else - libc='blurfl' - fi -fi -if $test $xxx = apollo -o -r "$libc" || (test -h "$libc") >/dev/null 2>&1; then - dflt="$libc" - cat < libpath - cat >&4 < libnames -set X `cat libnames` -shift -xxx=files -case $# in 1) xxx=file; esac -echo "Extracting names from the following $xxx for later perusal:" >&4 -echo " " -$sed 's/^/ /' libnames >&4 -echo " " -$echo $n "This may take a while...$c" >&4 - -for file in $*; do - case $file in - *$so*) $nm $nm_so_opt $nm_opt $file 2>/dev/null;; - *) $nm $nm_opt $file 2>/dev/null;; - esac -done >libc.tmp - -$echo $n ".$c" -$grep fprintf libc.tmp > libc.ptf -xscan='eval "libc.list"; $echo $n ".$c" >&4' -xrun='eval "libc.list"; echo "done" >&4' -xxx='[ADTSIW]' -if com="$sed -n -e 's/__IO//' -e 's/^.* $xxx *_[_.]*//p' -e 's/^.* $xxx *//p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e 's/^__*//' -e 's/^\([a-zA-Z_0-9$]*\).*xtern.*/\1/p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e '/|UNDEF/d' -e '/FUNC..GL/s/^.*|__*//p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e 's/^.* D __*//p' -e 's/^.* D //p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e 's/^_//' -e 's/^\([a-zA-Z_0-9]*\).*xtern.*text.*/\1/p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e 's/^.*|FUNC |GLOB .*|//p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$grep '|' | $sed -n -e '/|COMMON/d' -e '/|DATA/d' \ - -e '/ file/d' -e 's/^\([^ ]*\).*/\1/p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e 's/^.*|FUNC |GLOB .*|//p' -e 's/^.*|FUNC |WEAK .*|//p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e 's/^__//' -e '/|Undef/d' -e '/|Proc/s/ .*//p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e 's/^.*|Proc .*|Text *| *//p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e '/Def. Text/s/.* \([^ ]*\)\$/\1/p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e 's/^[-0-9a-f ]*_\(.*\)=.*/\1/p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e 's/.*\.text n\ \ \ \.//p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="sed -n -e 's/^__.*//' -e 's/[ ]*D[ ]*[0-9]*.*//p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -else - $nm -p $* 2>/dev/null >libc.tmp - $grep fprintf libc.tmp > libc.ptf - if com="$sed -n -e 's/^.* [ADTSIW] *_[_.]*//p' -e 's/^.* [ADTSIW] //p'";\ - eval $xscan; $contains '^fprintf$' libc.list >/dev/null 2>&1 - then - nm_opt='-p' - eval $xrun - else - echo " " - echo "$nm didn't seem to work right. Trying $ar instead..." >&4 - com='' - if $ar t $libc > libc.tmp && $contains '^fprintf$' libc.tmp >/dev/null 2>&1; then - for thisname in $libnames $libc; do - $ar t $thisname >>libc.tmp - done - $sed -e "s/\\$_o\$//" < libc.tmp > libc.list - echo "Ok." >&4 - elif test "X$osname" = "Xos2" && $ar tv $libc > libc.tmp; then - # Repeat libc to extract forwarders to DLL entries too - for thisname in $libnames $libc; do - $ar tv $thisname >>libc.tmp - # Revision 50 of EMX has bug in $ar. - # it will not extract forwarders to DLL entries - # Use emximp which will extract exactly them. - emximp -o tmp.imp $thisname \ - 2>/dev/null && \ - $sed -e 's/^\([_a-zA-Z0-9]*\) .*$/\1/p' \ - < tmp.imp >>libc.tmp - $rm tmp.imp - done - $sed -e "s/\\$_o\$//" -e 's/^ \+//' < libc.tmp > libc.list - echo "Ok." >&4 - else - echo "$ar didn't seem to work right." >&4 - echo "Maybe this is a Cray...trying bld instead..." >&4 - if bld t $libc | $sed -e 's/.*\///' -e "s/\\$_o:.*\$//" > libc.list - then - for thisname in $libnames; do - bld t $libnames | \ - $sed -e 's/.*\///' -e "s/\\$_o:.*\$//" >>libc.list - $ar t $thisname >>libc.tmp - done - echo "Ok." >&4 - else - echo "That didn't work either. Giving up." >&4 - exit 1 - fi - fi - fi -fi -nm_extract="$com" -if $test -f /lib/syscalls.exp; then - echo " " - echo "Also extracting names from /lib/syscalls.exp for good ole AIX..." >&4 - $sed -n 's/^\([^ ]*\)[ ]*syscall[0-9]*$/\1/p' /lib/syscalls.exp >>libc.list -fi -;; -esac -$rm -f libnames libpath - : see if dld is available set dld.h i_dld eval $inhdr -: is a C symbol defined? -csym='tlook=$1; -case "$3" in --v) tf=libc.tmp; tc=""; tdc="";; --a) tf=libc.tmp; tc="[0]"; tdc="[]";; -*) tlook="^$1\$"; tf=libc.list; tc="()"; tdc="()";; -esac; -tx=yes; -case "$reuseval-$4" in -true-) ;; -true-*) tx=no; eval "tval=\$$4"; case "$tval" in "") tx=yes;; esac;; -esac; -case "$tx" in -yes) - case "$runnm" in - true) - if $contains $tlook $tf >/dev/null 2>&1; - then tval=true; - else tval=false; - fi;; - *) - echo "int main() { extern short $1$tdc; printf(\"%hd\", $1$tc); }" > t.c; - if $cc $optimize $ccflags $ldflags -o t t.c $libs >/dev/null 2>&1; - then tval=true; - else tval=false; - fi; - $rm -f t t.c;; - esac;; -*) - case "$tval" in - $define) tval=true;; - *) tval=false;; - esac;; -esac; -eval "$2=$tval"' - -: define an is-in-libc? function -inlibc='echo " "; td=$define; tu=$undef; -sym=$1; var=$2; eval "was=\$$2"; -tx=yes; -case "$reuseval$was" in -true) ;; -true*) tx=no;; -esac; -case "$tx" in -yes) - set $sym tres -f; - eval $csym; - case "$tres" in - true) - echo "$sym() found." >&4; - case "$was" in $undef) . ./whoa; esac; eval "$var=\$td";; - *) - echo "$sym() NOT found." >&4; - case "$was" in $define) . ./whoa; esac; eval "$var=\$tu";; - esac;; -*) - case "$was" in - $define) echo "$sym() found." >&4;; - *) echo "$sym() NOT found." >&4;; - esac;; -esac' - : see if dlopen exists xxx_runnm="$runnm" runnm=false @@ -6173,13 +6502,13 @@ EOM hpux) dflt='+z' ;; next) dflt='none' ;; irix*) dflt='-KPIC' ;; - svr4*|esix*|solaris) dflt='-KPIC' ;; + svr4*|esix*|solaris|nonstopux) dflt='-KPIC' ;; sunos) dflt='-pic' ;; *) dflt='none' ;; esac ;; *) case "$osname" in - svr4*|esix*|solaris) dflt='-fPIC' ;; + svr4*|esix*|solaris|nonstopux) dflt='-fPIC' ;; *) dflt='-fpic' ;; esac ;; esac ;; @@ -6255,7 +6584,7 @@ EOM next) dflt='none' ;; solaris) dflt='-G' ;; sunos) dflt='-assert nodefinitions' ;; - svr4*|esix*) dflt="-G $ldflags" ;; + svr4*|esix*|nonstopux) dflt="-G $ldflags" ;; *) dflt='none' ;; esac ;; @@ -6269,7 +6598,7 @@ EOM esac for thisflag in $ldflags; do case "$thisflag" in - -L*) + -L*|-R*) case " $dflt " in *" $thisflag "*) ;; *) dflt="$dflt $thisflag" ;; @@ -6330,7 +6659,7 @@ $undef) ;; *) case "$useshrplib" in '') case "$osname" in - svr4*|dgux|dynixptx|esix|powerux|beos|cygwin*) + svr4*|nonstopux|dgux|dynixptx|esix|powerux|beos|cygwin*) dflt=y also='Building a shared libperl is required for dynamic loading to work on your system.' ;; @@ -6444,7 +6773,7 @@ case "$shrpdir" in *) $cat >&4 <&4 +else + echo "Could not find manual pages in source form." >&4 +fi + : determine where manual pages go set man1dir man1dir none eval $prefixit @@ -6901,18 +7248,23 @@ case "$myhostname" in /[ ]$myhostname[ . ]/p" > hosts } tmp_re="[ . ]" - $test x`$awk "/[0-9].*[ ]$myhostname$tmp_re/ { sum++ } + if $test -f hosts; then + $test x`$awk "/[0-9].*[ ]$myhostname$tmp_re/ { sum++ } END { print sum }" hosts` = x1 || tmp_re="[ ]" - dflt=.`$awk "/[0-9].*[ ]$myhostname$tmp_re/ {for(i=2; i<=NF;i++) print \\\$i}" \ - hosts | $sort | $uniq | \ - $sed -n -e "s/$myhostname\.\([-a-zA-Z0-9_.]\)/\1/p"` - case `$echo X$dflt` in - X*\ *) echo "(Several hosts in /etc/hosts matched hostname)" + dflt=.`$awk "/[0-9].*[ ]$myhostname$tmp_re/ {for(i=2; i<=NF;i++) print \\\$i}" \ + hosts | $sort | $uniq | \ + $sed -n -e "s/$myhostname\.\([-a-zA-Z0-9_.]\)/\1/p"` + case `$echo X$dflt` in + X*\ *) echo "(Several hosts in the database matched hostname)" + dflt=. + ;; + X.) echo "(You do not have fully-qualified names in the hosts database)" + ;; + esac + else + echo "(I cannot locate a hosts database anywhere)" dflt=. - ;; - X.) echo "(You do not have fully-qualified names in /etc/hosts)" - ;; - esac + fi case "$dflt" in .) tans=`./loc resolv.conf X /etc /usr/etc` @@ -6939,6 +7291,11 @@ case "$myhostname" in esac ;; esac + case "$dflt$osname" in + .os390) echo "(Attempting domain name extraction from //'SYS1.TCPPARMS(TCPDATA)')" + dflt=.`awk '/^DOMAINORIGIN/ {print $2}' "//'SYS1.TCPPARMS(TCPDATA)'" 2>/dev/null` + ;; + esac case "$dflt" in .) echo "(Lost all hope -- silly guess then)" dflt='.uucp' @@ -7028,7 +7385,7 @@ $cat <&4 - -*** You requested the use of long doubles but you do not seem to have -*** the mathematic functions for long doubles. I'm disabling the use -*** of long doubles. - -EOM - uselongdouble=$undef - ;; -esac - case "$useperlio" in $define|true|[yY]*) dflt='y';; *) dflt='n';; @@ -7315,82 +7602,6 @@ fi set qgcvt d_qgcvt eval $inlibc -: check for length of double -echo " " -case "$doublesize" in -'') - echo "Checking to see how big your double precision numbers are..." >&4 - $cat >try.c <<'EOCP' -#include -int main() -{ - printf("%d\n", (int)sizeof(double)); - exit(0); -} -EOCP - set try - if eval $compile_ok; then - doublesize=`./try` - echo "Your double is $doublesize bytes long." - else - dflt='8' - echo "(I can't seem to compile the test program. Guessing...)" - rp="What is the size of a double precision number (in bytes)?" - . ./myread - doublesize="$ans" - fi - ;; -esac -$rm -f try.c try - -: check for long doubles -echo " " -echo "Checking to see if you have long double..." >&4 -echo 'int main() { long double x = 7.0; }' > try.c -set try -if eval $compile; then - val="$define" - echo "You have long double." -else - val="$undef" - echo "You do not have long double." -fi -$rm try.* -set d_longdbl -eval $setvar - -: check for length of long double -case "${d_longdbl}${longdblsize}" in -$define) - echo " " - echo "Checking to see how big your long doubles are..." >&4 - $cat >try.c <<'EOCP' -#include -int main() -{ - printf("%d\n", sizeof(long double)); -} -EOCP - set try - set try - if eval $compile; then - longdblsize=`./try$exe_ext` - echo "Your long doubles are $longdblsize bytes long." - else - dflt='8' - echo " " - echo "(I can't seem to compile the test program. Guessing...)" >&4 - rp="What is the size of a long double (in bytes)?" - . ./myread - longdblsize="$ans" - fi - if $test "X$doublesize" = "X$longdblsize"; then - echo "(That isn't any different from an ordinary double.)" - fi - ;; -esac -$rm -f try.* try - echo " " if $test X"$d_longdbl" = X"$define"; then @@ -7412,7 +7623,7 @@ EOCP case "$yyy" in 123.456) sPRIfldbl='"f"'; sPRIgldbl='"g"'; sPRIeldbl='"e"'; - sPRIFldbl='"F"'; sPRIGldbl='"G"'; sPRIEldbl='"E"'; + sPRIFUldbl='"F"'; sPRIGUldbl='"G"'; sPRIEUldbl='"E"'; echo "We will use %f." ;; esac @@ -7434,7 +7645,7 @@ EOCP case "$yyy" in 123.456) sPRIfldbl='"llf"'; sPRIgldbl='"llg"'; sPRIeldbl='"lle"'; - sPRIFldbl='"llF"'; sPRIGldbl='"llG"'; sPRIEldbl='"llE"'; + sPRIFUldbl='"llF"'; sPRIGUldbl='"llG"'; sPRIEUldbl='"llE"'; echo "We will use %llf." ;; esac @@ -7456,7 +7667,7 @@ EOCP case "$yyy" in 123.456) sPRIfldbl='"Lf"'; sPRIgldbl='"Lg"'; sPRIeldbl='"Le"'; - sPRIFldbl='"LF"'; sPRIGldbl='"LG"'; sPRIEldbl='"LE"'; + sPRIFUldbl='"LF"'; sPRIGUldbl='"LG"'; sPRIEUldbl='"LE"'; echo "We will use %Lf." ;; esac @@ -7478,7 +7689,7 @@ EOCP case "$yyy" in 123.456) sPRIfldbl='"lf"'; sPRIgldbl='"lg"'; sPRIeldbl='"le"'; - sPRIFldbl='"lF"'; sPRIGldbl='"lG"'; sPRIEldbl='"lE"'; + sPRIFUldbl='"lF"'; sPRIGUldbl='"lG"'; sPRIEUldbl='"lE"'; echo "We will use %lf." ;; esac @@ -7487,6 +7698,8 @@ fi if $test X"$sPRIfldbl" = X; then echo "Cannot figure out how to print long doubles." >&4 +else + sSCNfldbl=$sPRIfldbl # expect consistency fi $rm -f try try.* @@ -7495,28 +7708,29 @@ fi # d_longdbl case "$sPRIfldbl" in '') d_PRIfldbl="$undef"; d_PRIgldbl="$undef"; d_PRIeldbl="$undef"; - d_PRIFldbl="$undef"; d_PRIGldbl="$undef"; d_PRIEldbl="$undef"; + d_PRIFUldbl="$undef"; d_PRIGUldbl="$undef"; d_PRIEUldbl="$undef"; + d_SCNfldbl="$undef"; ;; *) d_PRIfldbl="$define"; d_PRIgldbl="$define"; d_PRIeldbl="$define"; - d_PRIFldbl="$define"; d_PRIGldbl="$define"; d_PRIEldbl="$define"; + d_PRIFUldbl="$define"; d_PRIGUldbl="$define"; d_PRIEUldbl="$define"; + d_SCNfldbl="$define"; ;; esac : Check how to convert floats to strings. -if test "X$d_Gconvert" = X; then - echo " " - echo "Checking for an efficient way to convert floats to strings." - echo " " > try.c - case "$uselongdouble" in - "$define") echo "#define USE_LONG_DOUBLE" >>try.c ;; - esac - case "$d_longdbl" in - "$define") echo "#define HAS_LONG_DOUBLE" >>try.c ;; - esac - case "$d_PRIgldbl" in - "$define") echo "#define HAS_PRIgldbl" >>try.c ;; - esac - $cat >>try.c < try.c +case "$uselongdouble" in +"$define") echo "#define USE_LONG_DOUBLE" >>try.c ;; +esac +case "$d_longdbl" in +"$define") echo "#define HAS_LONG_DOUBLE" >>try.c ;; +esac +case "$d_PRIgldbl" in +"$define") echo "#define HAS_PRIgldbl" >>try.c ;; +esac +$cat >>try.c <&4 - if ./try; then - echo "I'll use $xxx_convert to convert floats into a string." >&4 - break; - else - echo "...But $xxx_convert didn't work as I expected." - fi +for xxx_convert in $xxx_list; do + echo "Trying $xxx_convert..." + $rm -f try try$_o + set try -DTRY_$xxx_convert + if eval $compile; then + echo "$xxx_convert() found." >&4 + if ./try; then + echo "I'll use $xxx_convert to convert floats into a string." >&4 + break; else - echo "$xxx_convert NOT found." >&4 + echo "...But $xxx_convert didn't work as I expected." fi - done - - case "$xxx_convert" in - gconvert) d_Gconvert='gconvert((x),(n),(t),(b))' ;; - gcvt) d_Gconvert='gcvt((x),(n),(b))' ;; - qgcvt) d_Gconvert='qgcvt((x),(n),(b))' ;; - *) case "$uselongdouble$d_longdbl$d_PRIgldbl" in - "$define$define$define") - d_Gconvert="sprintf((b),\"%.*$sPRIgldbl\",(n),(x))" ;; - *) d_Gconvert='sprintf((b),"%.*g",(n),(x))' ;; - esac - ;; - esac -fi + else + echo "$xxx_convert NOT found." >&4 + fi +done + +case "$xxx_convert" in +gconvert) d_Gconvert='gconvert((x),(n),(t),(b))' ;; +gcvt) d_Gconvert='gcvt((x),(n),(b))' ;; +qgcvt) d_Gconvert='qgcvt((x),(n),(b))' ;; +*) case "$uselongdouble$d_longdbl$d_PRIgldbl" in + "$define$define$define") + d_Gconvert="sprintf((b),\"%.*\"$sPRIgldbl,(n),(x))" ;; + *) d_Gconvert='sprintf((b),"%.*g",(n),(x))' ;; + esac + ;; +esac + +: see if _fwalk exists +set fwalk d__fwalk +eval $inlibc : Initialize h_fcntl h_fcntl=false @@ -7686,15 +7913,15 @@ int main() { EOCP : check sys/file.h first, no particular reason here if $test `./findhdr sys/file.h` && \ - $cc $cppflags -DI_SYS_FILE -o access access.c >/dev/null 2>&1 ; then + $cc -o access $cppflags -DI_SYS_FILE access.c >/dev/null 2>&1 ; then h_sysfile=true; echo " defines the *_OK access constants." >&4 elif $test `./findhdr fcntl.h` && \ - $cc $cppflags -DI_FCNTL -o access access.c >/dev/null 2>&1 ; then + $cc -o access $cppflags -DI_FCNTL access.c >/dev/null 2>&1 ; then h_fcntl=true; echo " defines the *_OK access constants." >&4 elif $test `./findhdr unistd.h` && \ - $cc $cppflags -DI_UNISTD -o access access.c >/dev/null 2>&1 ; then + $cc -o access $cppflags -DI_UNISTD access.c >/dev/null 2>&1 ; then echo " defines the *_OK access constants." >&4 else echo "I can't find the four *_OK access constants--I'll use mine." >&4 @@ -7784,10 +8011,10 @@ int main() exit(1); } EOP - if $cc -DTRY_BSD_PGRP $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1 && ./set; then + if $cc -o set -DTRY_BSD_PGRP $ccflags $ldflags set.c $libs >/dev/null 2>&1 && ./set; then echo "You have to use getpgrp(pid) instead of getpgrp()." >&4 val="$define" - elif $cc $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1 && ./set; then + elif $cc -o set $ccflags $ldflags set.c $libs >/dev/null 2>&1 && ./set; then echo "You have to use getpgrp() instead of getpgrp(pid)." >&4 val="$undef" else @@ -7846,10 +8073,10 @@ int main() exit(1); } EOP - if $cc -DTRY_BSD_PGRP $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1 && ./set; then + if $cc -o set -DTRY_BSD_PGRP $ccflags $ldflags set.c $libs >/dev/null 2>&1 && ./set; then echo 'You have to use setpgrp(pid,pgrp) instead of setpgrp().' >&4 val="$define" - elif $cc $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1 && ./set; then + elif $cc -o set $ccflags $ldflags set.c $libs >/dev/null 2>&1 && ./set; then echo 'You have to use setpgrp() instead of setpgrp(pid,pgrp).' >&4 val="$undef" else @@ -8401,8 +8628,8 @@ EOM : Call the object file tmp-dyna.o in case dlext=o. if $cc $ccflags $cccdlflags -c dyna.c > /dev/null 2>&1 && mv dyna${_o} tmp-dyna${_o} > /dev/null 2>&1 && - $ld $lddlflags -o dyna.$dlext tmp-dyna${_o} > /dev/null 2>&1 && - $cc $ccflags -o fred $ldflags $cccdlflags $ccdlflags fred.c $libs > /dev/null 2>&1; then + $ld -o dyna.$dlext $lddlflags tmp-dyna${_o} > /dev/null 2>&1 && + $cc -o fred $ccflags $ldflags $cccdlflags $ccdlflags fred.c $libs > /dev/null 2>&1; then xxx=`./fred` case $xxx in 1) echo "Test program failed using dlopen." >&4 @@ -8481,10 +8708,6 @@ eval $inlibc set endservent d_endsent eval $inlibc -: see if endspent exists -set endspent d_endspent -eval $inlibc - : Locate the flags for 'open()' echo " " $cat >open3.c <<'EOCP' @@ -8645,8 +8868,12 @@ int main() int ret; close(pd[1]); /* Parent reads from pd[0] */ close(pu[0]); /* Parent writes (blocking) to pu[1] */ +#ifdef F_SETFL if (-1 == fcntl(pd[0], F_SETFL, MY_O_NONBLOCK)) exit(1); +#else + exit(4); +#endif signal(SIGALRM, blech); alarm(5); if ((ret = read(pd[0], buf, 1)) > 0) /* Nothing to read! */ @@ -8693,6 +8920,7 @@ EOCP 1) echo "Could not perform non-blocking setting!";; 2) echo "I did a successful read() for something that was not there!";; 3) echo "Hmm... non-blocking I/O does not seem to be working!";; + 4) echo "Could not find F_SETFL!";; *) echo "Something terribly wrong happened during testing.";; esac rd_nodata=`$cat try.ret` @@ -8758,6 +8986,54 @@ eval $inlibc set fcntl d_fcntl eval $inlibc +echo " " +: See if fcntl-based locking works. +$cat >try.c <<'EOCP' +#include +#include +#include +int main() { +#if defined(F_SETLK) && defined(F_SETLKW) + struct flock flock; + int retval, fd; + fd = open("try.c", O_RDONLY); + flock.l_type = F_RDLCK; + flock.l_whence = SEEK_SET; + flock.l_start = flock.l_len = 0; + retval = fcntl(fd, F_SETLK, &flock); + close(fd); + (retval < 0 ? exit(2) : exit(0)); +#else + exit(2); +#endif +} +EOCP +echo "Checking if fcntl-based file locking works... " +case "$d_fcntl" in +"$define") + set try + if eval $compile_ok; then + if ./try; then + echo "Yes, it seems to work." + val="$define" + else + echo "Nope, it didn't work." + val="$undef" + fi + else + echo "I'm unable to compile the test program, so I'll assume not." + val="$undef" + fi + ;; +*) val="$undef"; + echo "Nope, since you don't even have fcntl()." + ;; +esac +set d_fcntl_can_lock +eval $setvar +$rm -f try* + + hasfield='varname=$1; struct=$2; field=$3; shift; shift; shift; while $test $# -ge 2; do case "$1" in @@ -9064,6 +9340,10 @@ $rm -f try.* try set d_fpos64_t eval $setvar +: see if frexpl exists +set frexpl d_frexpl +eval $inlibc + hasstruct='varname=$1; struct=$2; shift; shift; while $test $# -ge 2; do case "$1" in @@ -9130,6 +9410,10 @@ set fstatvfs d_fstatvfs eval $inlibc +: see if fsync exists +set fsync d_fsync +eval $inlibc + : see if ftello exists set ftello d_ftello eval $inlibc @@ -9141,6 +9425,10 @@ esac set getcwd d_getcwd eval $inlibc +: see if getespwnam exists +set getespwnam d_getespwnam +eval $inlibc + : see if getfsstat exists set getfsstat d_getfsstat @@ -9285,6 +9573,10 @@ echo " " set d_getnetprotos getnetent $i_netdb netdb.h eval $hasproto +: see if getpagesize exists +set getpagesize d_getpagsz +eval $inlibc + : see if getprotobyname exists set getprotobyname d_getpbyname @@ -9319,6 +9611,10 @@ echo " " set d_getprotoprotos getprotoent $i_netdb netdb.h eval $hasproto +: see if getprpwnam exists +set getprpwnam d_getprpwnam +eval $inlibc + : see if getpwent exists set getpwent d_getpwent eval $inlibc @@ -9341,10 +9637,6 @@ echo " " set d_getservprotos getservent $i_netdb netdb.h eval $hasproto -: see if getspent exists -set getspent d_getspent -eval $inlibc - : see if getspnam exists set getspnam d_getspnam eval $inlibc @@ -9554,6 +9846,14 @@ set d_isascii eval $setvar $rm -f isascii* +: see if isnan exists +set isnan d_isnan +eval $inlibc + +: see if isnanl exists +set isnanl d_isnanl +eval $inlibc + : see if killpg exists set killpg d_killpg eval $inlibc @@ -9636,7 +9936,7 @@ echo 'int main() { long long x = 7; return 0; }' > try.c set try if eval $compile; then val="$define" - echo "You have have long long." + echo "You have long long." else val="$undef" echo "You do not have long long." @@ -9773,6 +10073,10 @@ esac +: see if modfl exists +set modfl d_modfl +eval $inlibc + : see if mprotect exists set mprotect d_mprotect eval $inlibc @@ -9935,6 +10239,37 @@ rp="What is the size of a character (in bytes)?" charsize="$ans" $rm -f try.c try +: check for volatile keyword +echo " " +echo 'Checking to see if your C compiler knows about "volatile"...' >&4 +$cat >try.c <<'EOCP' +int main() +{ + typedef struct _goo_struct goo_struct; + goo_struct * volatile goo = ((goo_struct *)0); + struct _goo_struct { + long long_int; + int reg_int; + char char_var; + }; + typedef unsigned short foo_t; + char *volatile foo; + volatile int bar; + volatile foo_t blech; + foo = foo; +} +EOCP +if $cc -c $ccflags try.c >/dev/null 2>&1 ; then + val="$define" + echo "Yup, it does." +else + val="$undef" + echo "Nope, it doesn't." +fi +set d_volatile +eval $setvar +$rm -f try.* + echo " " $echo "Choosing the C types to be used for Perl's internal types..." >&4 @@ -10113,31 +10448,64 @@ case "$i64type" in ;; esac -$echo "Checking whether your NVs can preserve your UVs..." >&4 +$echo "Checking how many bits of your UVs your NVs can preserve..." >&4 +: volatile so that the compiler has to store it out to memory. +if test X"$d_volatile" = X"$define"; then + volatile=volatile +fi $cat <try.c #include +#include +#include +#ifdef SIGFPE +$volatile int bletched = 0; +$signal_t blech(s) int s; { bletched = 1; } +#endif int main() { - $uvtype k = ($uvtype)~0, l; + $uvtype u = 0; $nvtype d; - l = k; - d = ($nvtype)l; - l = ($uvtype)d; - if (l == k) - printf("preserve\n"); + int n = 8 * $uvsize; + int i; +#ifdef SIGFPE + signal(SIGFPE, blech); +#endif + + for (i = 0; i < n; i++) { + u = u << 1 | ($uvtype)1; + d = ($nvtype)u; + if (($uvtype)d != u) + break; + if (d <= 0) + break; + d = ($nvtype)(u - 1); + if (($uvtype)d != (u - 1)) + break; +#ifdef SIGFPE + if (bletched) { + break; +#endif + } + } + printf("%d\n", ((i == n) ? -n : i)); exit(0); } EOP set try + +d_nv_preserves_uv="$undef" if eval $compile; then - case "`./try$exe_ext`" in - preserve) d_nv_preserves_uv="$define" ;; - esac -fi -case "$d_nv_preserves_uv" in -$define) $echo "Yes, they can." 2>&1 ;; -*) $echo "No, they can't." 2>&1 - d_nv_preserves_uv="$undef" - ;; + d_nv_preserves_uv_bits="`./try$exe_ext`" +fi +case "$d_nv_preserves_uv_bits" in +\-[1-9]*) + d_nv_preserves_uv_bits=`expr 0 - $d_nv_preserves_uv_bits` + $echo "Your NVs can preserve all $d_nv_preserves_uv_bits bits of your UVs." 2>&1 + d_nv_preserves_uv="$define" + ;; +[1-9]*) $echo "Your NVs can preserve only $d_nv_preserves_uv_bits bits of your UVs." 2>&1 + d_nv_preserves_uv="$undef" ;; +*) $echo "Can't figure out how many bits your NVs preserve." 2>&1 + d_nv_preserves_uv_bits="$undef" ;; esac $rm -f try.* try @@ -10655,6 +11023,11 @@ $rm -f try.* try core set d_sanemcmp eval $setvar +: see if prototype for sbrk is available +echo " " +set d_sbrkproto sbrk $i_unistd unistd.h +eval $hasproto + : see if select exists set select d_select eval $inlibc @@ -10972,10 +11345,6 @@ eval $inlibc set setsid d_setsid eval $inlibc -: see if setspent exists -set setspent d_setspent -eval $inlibc - : see if setvbuf exists set setvbuf d_setvbuf eval $inlibc @@ -11004,24 +11373,29 @@ $define) *) dflt='n';; esac echo "$package can use the sfio library, but it is experimental." + case "$useperlio" in + "$undef") + echo "For sfio also the PerlIO abstraction layer is needed." + echo "Earlier you said you wouldn't want that." + ;; + esac rp="You seem to have sfio available, do you want to try using it?" . ./myread case "$ans" in - y|Y) ;; + y|Y) echo "Ok, turning on both sfio and PerlIO, then." + useperlio="$define" + val="$define" + ;; *) echo "Ok, avoiding sfio this time. I'll use stdio instead." val="$undef" - : Remove sfio from list of libraries to use - set `echo X $libs | $sed -e 's/-lsfio / /' -e 's/-lsfio$//'` - shift - libs="$*" - echo "libs = $libs" >&4 ;; esac ;; *) case "$usesfio" in true|$define|[yY]*) - echo "Sorry, cannot find sfio on this machine" >&4 - echo "Ignoring your setting of usesfio=$usesfio" >&4 + echo "Sorry, cannot find sfio on this machine." >&4 + echo "Ignoring your setting of usesfio=$usesfio." >&4 + val="$undef" ;; esac ;; @@ -11032,6 +11406,16 @@ case "$d_sfio" in $define) usesfio='true';; *) usesfio='false';; esac +case "$d_sfio" in +$define) ;; +*) : Remove sfio from list of libraries to use + set `echo X $libs | $sed -e 's/-lsfio / /' -e 's/-lsfio$//'` + shift + libs="$*" + echo "libs = $libs" >&4 +;; +esac + : see if shmctl exists set shmctl d_shmctl @@ -11190,6 +11574,10 @@ set d_sigsetjmp eval $setvar $rm -f try.c try +: see if socks5_init exists +set socks5_init d_socks5_init +eval $inlibc + : see if sys/stat.h is available set sys/stat.h i_sysstat eval $inhdr @@ -11243,7 +11631,28 @@ esac : see if _ptr and _cnt from stdio act std echo " " -if $contains '_IO_fpos_t' `./findhdr stdio.h` `./findhdr libio.h` >/dev/null 2>&1 ; then + +if $contains '_lbfsize' `./findhdr stdio.h` >/dev/null 2>&1 ; then + echo "(Looks like you have stdio.h from BSD.)" + case "$stdio_ptr" in + '') stdio_ptr='((fp)->_p)' + ptr_lval=$define + ;; + *) ptr_lval=$d_stdio_ptr_lval;; + esac + case "$stdio_cnt" in + '') stdio_cnt='((fp)->_r)' + cnt_lval=$define + ;; + *) cnt_lval=$d_stdio_cnt_lval;; + esac + case "$stdio_base" in + '') stdio_base='((fp)->_ub._base ? (fp)->_ub._base : (fp)->_bf._base)';; + esac + case "$stdio_bufsiz" in + '') stdio_bufsiz='((fp)->_ub._base ? (fp)->_ub._size : (fp)->_bf._size)';; + esac +elif $contains '_IO_fpos_t' `./findhdr stdio.h` `./findhdr libio.h` >/dev/null 2>&1 ; then echo "(Looks like you have stdio.h from Linux.)" case "$stdio_ptr" in '') stdio_ptr='((fp)->_IO_read_ptr)' @@ -11283,6 +11692,7 @@ else '') stdio_bufsiz='((fp)->_cnt + (fp)->_ptr - (fp)->_base)';; esac fi + : test whether _ptr and _cnt really work echo "Checking how std your stdio is..." >&4 $cat >try.c <&4 +$cat >try.c < +/* Can we scream? */ +/* Eat dust sed :-) */ +/* In the buffer space, no one can hear you scream. */ +#define FILE_ptr(fp) $stdio_ptr +#define FILE_cnt(fp) $stdio_cnt +#include +int main() { + FILE *fp = fopen("try.c", "r"); + int c; + char *ptr; + size_t cnt; + if (!fp) { + puts("Fail even to read"); + exit(1); + } + c = getc(fp); /* Read away the first # */ + if (c == EOF) { + puts("Fail even to read"); + exit(1); + } + if (!( + 18 <= FILE_cnt(fp) && + strncmp(FILE_ptr(fp), "include \n", 18) == 0 + )) { + puts("Fail even to read"); + exit (1); + } + ptr = (char*) FILE_ptr(fp); + cnt = (size_t)FILE_cnt(fp); + + FILE_ptr(fp) += 42; + + if ((char*)FILE_ptr(fp) != (ptr + 42)) { + printf("Fail ptr check %p != %p", FILE_ptr(fp), (ptr + 42)); + exit (1); + } + if (FILE_cnt(fp) <= 20) { + printf ("Fail (<20 chars to test)"); + exit (1); + } + if (strncmp(FILE_ptr(fp), "Eat dust sed :-) */\n", 20) != 0) { + puts("Fail compare"); + exit (1); + } + if (cnt == FILE_cnt(fp)) { + puts("Pass_unchanged"); + exit (0); + } + if (FILE_cnt(fp) == (cnt - 42)) { + puts("Pass_changed"); + exit (0); + } + printf("Fail count was %d now %d\n", cnt, FILE_cnt(fp)); + return 1; + +} +EOP + set try + if eval $compile; then + case `./try$exe_ext` in + Pass_changed) + echo "Increasing ptr in your stdio decreases cnt by the same amount. Good." >&4 + d_stdio_ptr_lval_sets_cnt="$define" ;; + Pass_unchanged) + echo "Increasing ptr in your stdio leaves cnt unchanged. Good." >&4 + d_stdio_ptr_lval_nochange_cnt="$define" ;; + Fail*) + echo "Increasing ptr in your stdio didn't do exactly what I expected. We'll not be doing that then." >&4 ;; + *) + echo "It appears attempting to set ptr in your stdio is a bad plan." >&4 ;; + esac + else + echo "It seems we can't set ptr in your stdio. Nevermind." >&4 + fi + $rm -f try.c try + ;; +esac + : see if _base is also standard val="$undef" case "$d_stdstdio" in @@ -11496,6 +11993,9 @@ EOM #ifdef __hpux #define strtoll __strtoll #endif +#ifdef __EMX__ +#define strtoll _strtoll +#endif #include extern long long int strtoll(char *s, char **, int); static int bad = 0; @@ -11522,7 +12022,8 @@ int main() { EOCP set try if eval $compile; then - case "`./try`" in + yyy=`./try` + case "$yyy" in ok) echo "Your strtoll() seems to be working okay." ;; *) cat <&4 Your strtoll() doesn't seem to be working okay. @@ -11530,6 +12031,9 @@ EOM d_strtoll="$undef" ;; esac + else + echo "(I can't seem to compile the test program--assuming it doesn't)" + d_strtoll="$undef" fi ;; esac @@ -11780,37 +12284,6 @@ esac set d_void_closedir eval $setvar $rm -f closedir* -: check for volatile keyword -echo " " -echo 'Checking to see if your C compiler knows about "volatile"...' >&4 -$cat >try.c <<'EOCP' -int main() -{ - typedef struct _goo_struct goo_struct; - goo_struct * volatile goo = ((goo_struct *)0); - struct _goo_struct { - long long_int; - int reg_int; - char char_var; - }; - typedef unsigned short foo_t; - char *volatile foo; - volatile int bar; - volatile foo_t blech; - foo = foo; -} -EOCP -if $cc -c $ccflags try.c >/dev/null 2>&1 ; then - val="$define" - echo "Yup, it does." -else - val="$undef" - echo "Nope, it doesn't." -fi -set d_volatile -eval $setvar -$rm -f try.* - : see if there is a wait4 set wait4 d_wait4 eval $inlibc @@ -12418,14 +12891,14 @@ val=$undef set tebcdic if eval $compile_ok; then if ./tebcdic; then - echo "You have EBCDIC." >&4 + echo "You seem to speak EBCDIC." >&4 val="$define" else - echo "Nope, no EBCDIC, probably ASCII or some ISO Latin." >&4 + echo "Nope, no EBCDIC, probably ASCII or some ISO Latin. Or UTF8." >&4 fi else echo "I'm unable to compile the test program." >&4 - echo "I'll assume ASCII or some ISO Latin." >&4 + echo "I'll assume ASCII or some ISO Latin. Or UTF8." >&4 fi $rm -f tebcdic.c tebcdic set ebcdic @@ -12833,7 +13306,7 @@ EOCP case "$yyy" in 12345678901) sPRId64='"d"'; sPRIi64='"i"'; sPRIu64='"u"'; - sPRIo64='"o"'; sPRIx64='"x"'; sPRIX64='"X"'; + sPRIo64='"o"'; sPRIx64='"x"'; sPRIXU64='"X"'; echo "We will use %d." ;; esac @@ -12855,7 +13328,7 @@ EOCP case "$yyy" in 12345678901) sPRId64='"ld"'; sPRIi64='"li"'; sPRIu64='"lu"'; - sPRIo64='"lo"'; sPRIx64='"lx"'; sPRIX64='"lX"'; + sPRIo64='"lo"'; sPRIx64='"lx"'; sPRIXU64='"lX"'; echo "We will use %ld." ;; esac @@ -12878,7 +13351,7 @@ EOCP case "$yyy" in 12345678901) sPRId64=PRId64; sPRIi64=PRIi64; sPRIu64=PRIu64; - sPRIo64=PRIo64; sPRIx64=PRIx64; sPRIX64=PRIX64; + sPRIo64=PRIo64; sPRIx64=PRIx64; sPRIXU64=PRIXU64; echo "We will use the C9X style." ;; esac @@ -12890,7 +13363,7 @@ if $test X"$sPRId64" = X -a X"$quadtype" = X"long long"; then #include #include int main() { - long long q = 12345678901LL; /* AIX cc requires the LL prefix. */ + long long q = 12345678901LL; /* AIX cc requires the LL suffix. */ printf("%lld\n", q); } EOCP @@ -12900,7 +13373,7 @@ EOCP case "$yyy" in 12345678901) sPRId64='"lld"'; sPRIi64='"lli"'; sPRIu64='"llu"'; - sPRIo64='"llo"'; sPRIx64='"llx"'; sPRIX64='"llX"'; + sPRIo64='"llo"'; sPRIx64='"llx"'; sPRIXU64='"llX"'; echo "We will use the %lld style." ;; esac @@ -12922,7 +13395,7 @@ EOCP case "$yyy" in 12345678901) sPRId64='"Ld"'; sPRIi64='"Li"'; sPRIu64='"Lu"'; - sPRIo64='"Lo"'; sPRIx64='"Lx"'; sPRIX64='"LX"'; + sPRIo64='"Lo"'; sPRIx64='"Lx"'; sPRIXU64='"LX"'; echo "We will use %Ld." ;; esac @@ -12944,7 +13417,7 @@ EOCP case "$yyy" in 12345678901) sPRId64='"qd"'; sPRIi64='"qi"'; sPRIu64='"qu"'; - sPRIo64='"qo"'; sPRIx64='"qx"'; sPRIX64='"qX"'; + sPRIo64='"qo"'; sPRIx64='"qx"'; sPRIXU64='"qX"'; echo "We will use %qd." ;; esac @@ -12961,10 +13434,10 @@ fi case "$sPRId64" in '') d_PRId64="$undef"; d_PRIi64="$undef"; d_PRIu64="$undef"; - d_PRIo64="$undef"; d_PRIx64="$undef"; d_PRIX64="$undef"; + d_PRIo64="$undef"; d_PRIx64="$undef"; d_PRIXU64="$undef"; ;; *) d_PRId64="$define"; d_PRIi64="$define"; d_PRIu64="$define"; - d_PRIo64="$define"; d_PRIx64="$define"; d_PRIX64="$define"; + d_PRIo64="$define"; d_PRIx64="$define"; d_PRIXU64="$define"; ;; esac @@ -12977,18 +13450,21 @@ if $test X"$ivsize" = X8; then uvuformat="$sPRIu64" uvoformat="$sPRIo64" uvxformat="$sPRIx64" + uvXUformat="$sPRIXU64" else if $test X"$ivsize" = X"$longsize"; then ivdformat='"ld"' uvuformat='"lu"' uvoformat='"lo"' uvxformat='"lx"' + uvXUformat='"lX"' else if $test X"$ivsize" = X"$intsize"; then ivdformat='"d"' uvuformat='"u"' uvoformat='"o"' uvxformat='"x"' + uvXUformat='"X"' else : far out if $test X"$ivsize" = X"$shortsize"; then @@ -12996,11 +13472,28 @@ else uvuformat='"hu"' uvoformat='"ho"' uvxformat='"hx"' + uvXUformat='"hX"' fi fi fi fi +if $test X"$uselongdouble" = X"$define" -a X"$d_longdbl" = X"$define" -a X"$d_PRIgldbl" = X"$define"; then + nveformat="$sPRIeldbl" + nvfformat="$sPRIfldbl" + nvgformat="$sPRIgldbl" + nvEUformat="$sPRIEUldbl" + nvFUformat="$sPRIFUldbl" + nvGUformat="$sPRIGUldbl" +else + nveformat='"e"' + nvfformat='"f"' + nvgformat='"g"' + nvEUformat='"E"' + nvFUformat='"F"' + nvGUformat='"G"' +fi + case "$ivdformat" in '') echo "$0: Fatal: failed to find format strings, cannot continue." >& 4 exit 1 @@ -13279,12 +13772,15 @@ case "$pager" in dflt='' case "$pg" in /*) dflt=$pg;; + [a-zA-Z]:/*) dflt=$pg;; esac case "$more" in /*) dflt=$more;; + [a-zA-Z]:/*) dflt=$more;; esac case "$less" in /*) dflt=$less;; + [a-zA-Z]:/*) dflt=$less;; esac case "$dflt" in '') dflt=/usr/ucb/more;; @@ -13357,13 +13853,13 @@ $cc $ccflags -c bar1.c >/dev/null 2>&1 $cc $ccflags -c bar2.c >/dev/null 2>&1 $cc $ccflags -c foo.c >/dev/null 2>&1 $ar rc bar$_a bar2$_o bar1$_o >/dev/null 2>&1 -if $cc $ccflags $ldflags -o foobar foo$_o bar$_a $libs > /dev/null 2>&1 && +if $cc -o foobar $ccflags $ldflags foo$_o bar$_a $libs > /dev/null 2>&1 && ./foobar >/dev/null 2>&1; then echo "$ar appears to generate random libraries itself." orderlib=false ranlib=":" elif $ar ts bar$_a >/dev/null 2>&1 && - $cc $ccflags $ldflags -o foobar foo$_o bar$_a $libs > /dev/null 2>&1 && + $cc -o foobar $ccflags $ldflags foo$_o bar$_a $libs > /dev/null 2>&1 && ./foobar >/dev/null 2>&1; then echo "a table of contents needs to be added with '$ar ts'." orderlib=false @@ -13854,6 +14350,10 @@ $rm -f try try.* set d_socklen_t eval $setvar +: see if this is a socks.h system +set socks.h i_socks +eval $inhdr + : check for type of the size argument to socket calls case "$d_socket" in "$define") @@ -13861,7 +14361,6 @@ case "$d_socket" in Checking to see what type is the last argument of accept(). EOM - hdrs="$define sys/types.h $d_socket sys/socket.h" yyy='' case "$d_socklen_t" in "$define") yyy="$yyy socklen_t" @@ -13870,10 +14369,19 @@ EOM for xxx in $yyy; do case "$socksizetype" in '') try="extern int accept(int, struct sockaddr *, $xxx *);" - if ./protochk "$try" $hdrs; then - echo "Your system accepts '$xxx *' for the last argument of accept()." - socksizetype="$xxx" - fi + case "$usesocks" in + "$define") + if ./protochk "$try" $i_systypes sys/types.h $d_socket sys/socket.h literal '#define INCLUDE_PROTOTYPES' $i_socks socks.h.; then + echo "Your system accepts '$xxx *' for the last argument of accept()." + socksizetype="$xxx" + fi + ;; + *) if ./protochk "$try" $i_systypes sys/types.h $d_socket sys/socket.h; then + echo "Your system accepts '$xxx *' for the last argument of accept()." + socksizetype="$xxx" + fi + ;; + esac ;; esac done @@ -13934,13 +14442,15 @@ $rm -f ssize ssize.* : see what type of char stdio uses. echo " " -if $contains 'unsigned.*char.*_ptr;' `./findhdr stdio.h` >/dev/null 2>&1 ; then +echo '#include ' | $cppstdin $cppminus > stdioh +if $contains 'unsigned.*char.*_ptr;' stdioh >/dev/null 2>&1 ; then echo "Your stdio uses unsigned chars." >&4 stdchar="unsigned char" -else +else echo "Your stdio uses signed chars." >&4 stdchar="char" fi +$rm -f stdioh : see if time exists echo " " @@ -14090,6 +14600,37 @@ case "$uidsign" in ;; esac +: determine compiler compiler +case "$yacc" in +'') + dflt=yacc;; +*) + dflt="$yacc";; +esac +echo " " +comp='yacc' +if $test -f "$byacc"; then + dflt="$byacc" + comp="byacc or $comp" +fi +if $test -f "$bison"; then + comp="$comp or bison -y" +fi +rp="Which compiler compiler ($comp) shall I use?" +. ./myread +yacc="$ans" +case "$yacc" in +*bis*) + case "$yacc" in + *-y*) ;; + *) + yacc="$yacc -y" + echo "(Adding -y option to bison to get yacc-compatible behaviour.)" + ;; + esac + ;; +esac + : see if dbm.h is available : see if dbmclose exists set dbmclose d_dbmclose @@ -14264,14 +14805,18 @@ eval $inhdr set poll.h i_poll eval $inhdr +: see if this is a prot.h system +set prot.h i_prot +eval $inhdr + echo " " $echo "Guessing which symbols your C compiler and preprocessor define..." >&4 $cat <<'EOSH' > Cppsym.know a29k ABI64 aegis AES_SOURCE AIX AIX32 AIX370 AIX41 AIX42 AIX43 AIX_SOURCE aixpc ALL_SOURCE -alliant alpha am29000 AM29000 amiga AMIGAOS AMIX -ansi ANSI_C_SOURCE apollo ardent atarist att386 att3b BeOS -BIG_ENDIAN BIT_MSF bsd BSD bsd43 bsd4_2 bsd4_3 BSD4_3 bsd4_4 +alliant alpha am29000 AM29000 AMD64 amiga AMIGAOS AMIX +ansi ANSI_C_SOURCE apollo ardent ARM32 atarist att386 att3b +BeOS BIG_ENDIAN BIT_MSF bsd BSD bsd43 bsd4_2 bsd4_3 BSD4_3 bsd4_4 BSD_4_3 BSD_4_4 BSD_NET2 BSD_TIME BSD_TYPES BSDCOMPAT bsdi bull c cadmus clipper CMU COFF COMPILER_VERSION concurrent convex cpu cray CRAY CRAYMPP ctix CX_UX @@ -14284,7 +14829,7 @@ hp200 hp300 hp700 HP700 hp800 hp9000 hp9000s200 hp9000s300 hp9000s400 hp9000s500 hp9000s700 hp9000s800 hp9k8 hp_osf hppa hpux HPUX_SOURCE i186 i286 i386 i486 i586 i686 i8086 i80960 i860 I960 -iAPX286 ibm ibm032 ibmesa IBMR2 ibmrt ILP32 ILP64 +IA64 iAPX286 ibm ibm032 ibmesa IBMR2 ibmrt ILP32 ILP64 INLINE_INTRINSICS INTRINSICS INT64 interdata is68k ksr1 LANGUAGE_C LARGE_FILE_API LARGEFILE64_SOURCE LARGEFILE_SOURCE LFS64_LARGEFILE LFS_LARGEFILE @@ -14300,7 +14845,7 @@ mert MiNT mips MIPS_FPSET MIPS_ISA MIPS_SIM MIPS_SZINT MIPS_SZLONG MIPS_SZPTR MIPSEB MIPSEL MODERN_C motorola mpeix MSDOS MTXINU MULTIMAX mvs MVS n16 ncl_el ncl_mr NetBSD news1500 news1700 news1800 news1900 news3700 -news700 news800 news900 NeXT NLS ns16000 ns32000 +news700 news800 news900 NeXT NLS nonstopux ns16000 ns32000 ns32016 ns32332 ns32k nsc32000 OCS88 OEMVS OpenBSD os OS2 OS390 osf OSF1 OSF_SOURCE pa_risc PA_RISC1_1 PA_RISC2_0 PARAGON parisc @@ -14308,7 +14853,7 @@ pc532 pdp11 PGC PIC plexus PORTAR posix POSIX1B_SOURCE POSIX2_SOURCE POSIX4_SOURCE POSIX_C_SOURCE POSIX_SOURCE POWER PROTOTYPES PWB pyr QNX R3000 REENTRANT RES Rhapsody RISC6000 -riscix riscos RT scs SCO sequent sgi SGI_SOURCE sinix +riscix riscos RT S390 SA110 scs SCO sequent sgi SGI_SOURCE SH3 sinix SIZE_INT SIZE_LONG SIZE_PTR SOCKET_SOURCE SOCKETS_SOURCE sony sony_news sonyrisc sparc sparclite spectrum stardent stdc STDC_EXT stratos sun sun3 sun386 @@ -14316,6 +14861,7 @@ Sun386i svr3 svr4 SVR4_2 SVR4_SOURCE svr5 SX system SYSTYPE_BSD SYSTYPE_BSD43 SYSTYPE_BSD44 SYSTYPE_SVR4 SYSTYPE_SVR5 SYSTYPE_SYSV SYSV SYSV3 SYSV4 SYSV5 sysV68 sysV88 Tek4132 Tek4300 titan +TM3200 TM5400 TM5600 tower tower32 tower32_200 tower32_600 tower32_700 tower32_800 tower32_850 tss u370 u3b u3b2 u3b20 u3b200 u3b20d u3b5 @@ -14332,8 +14878,9 @@ $osname EOSH ./tr '[a-z]' '[A-Z]' < Cppsym.know > Cppsym.a ./tr '[A-Z]' '[a-z]' < Cppsym.know > Cppsym.b -$cat Cppsym.a Cppsym.b | $tr ' ' $trnl | sort | uniq > Cppsym.know -$rm -f Cppsym.a Cppsym.b +$cat Cppsym.know > Cppsym.c +$cat Cppsym.a Cppsym.b Cppsym.c | $tr ' ' $trnl | $sort | $uniq > Cppsym.know +$rm -f Cppsym.a Cppsym.b Cppsym.c cat < Cppsym $startsh if $test \$# -gt 0; then @@ -14372,8 +14919,9 @@ cat <> Cppsym.try ccflags="$ccflags" case "$osname-$gccversion" in irix-) ccflags="\$ccflags -woff 1178" ;; +os2-*) ccflags="\$ccflags -Zlinker /PM:VIO" ;; esac -$cc $optimize \$ccflags $ldflags -o try try.c $libs && ./try$exe_ext +$cc -o try $optimize \$ccflags $ldflags try.c $libs && ./try$exe_ext EOSH chmod +x Cppsym.try $eunicefix Cppsym.try @@ -14427,7 +14975,7 @@ if $test -z ccsym.raw; then else if $test -s ccsym.com; then echo "Your C compiler and pre-processor define these symbols:" - $sed -e 's/\(.*\)=.*/\1/' ccsym.com + $sed -e 's/\(..*\)=.*/\1/' ccsym.com also='also ' symbols='ones' cppccsymbols=`$cat ccsym.com` @@ -14437,7 +14985,7 @@ else if $test -s ccsym.cpp; then $test "$also" && echo " " echo "Your C pre-processor ${also}defines the following symbols:" - $sed -e 's/\(.*\)=.*/\1/' ccsym.cpp + $sed -e 's/\(..*\)=.*/\1/' ccsym.cpp also='further ' cppsymbols=`$cat ccsym.cpp` cppsymbols=`echo $cppsymbols` @@ -14446,14 +14994,14 @@ else if $test -s ccsym.own; then $test "$also" && echo " " echo "Your C compiler ${also}defines the following cpp symbols:" - $sed -e 's/\(.*\)=1/\1/' ccsym.own - $sed -e 's/\(.*\)=.*/\1/' ccsym.own | $uniq >>Cppsym.true + $sed -e 's/\(..*\)=1/\1/' ccsym.own + $sed -e 's/\(..*\)=.*/\1/' ccsym.own | $uniq >>Cppsym.true ccsymbols=`$cat ccsym.own` ccsymbols=`echo $ccsymbols` $test "$silent" || sleep 1 fi fi -$rm -f ccsym* +$rm -f ccsym* Cppsym.* : see if this is a termio system val="$undef" @@ -14514,10 +15062,6 @@ val=$val3; set i_termios; eval $setvar set shadow.h i_shadow eval $inhdr -: see if this is a socks.h system -set socks.h i_socks -eval $inhdr - : see if stdarg is available echo " " if $test `./findhdr stdarg.h`; then @@ -14835,6 +15379,12 @@ for xxx in $known_extensions ; do true|$define|y) avail_ext="$avail_ext $xxx" ;; esac ;; + Sys/Syslog|sys/syslog) + : XXX syslog requires socket + case "$d_socket" in + true|$define|y) avail_ext="$avail_ext $xxx" ;; + esac + ;; Thread|thread) case "$usethreads" in true|$define|y) avail_ext="$avail_ext $xxx" ;; @@ -14981,6 +15531,25 @@ set X $dynamic_ext $static_ext $nonxs_ext shift extensions="$*" +: Remove libraries needed only for extensions +: The appropriate ext/Foo/Makefile.PL will add them back in, if necessary. +: The exception is SunOS 4.x, which needs them. +case "${osname}X${osvers}" in +sunos*X4*) + perllibs="$libs" + ;; +*) case "$usedl" in + $define|true|[yY]*) + set X `echo " $libs " | sed -e 's@ -lndbm @ @' -e 's@ -lgdbm @ @' -e 's@ -ldbm @ @' -e 's@ -ldb @ @'` + shift + perllibs="$*" + ;; + *) perllibs="$libs" + ;; + esac + ;; +esac + : Remove build directory name from cppstdin so it can be used from : either the present location or the final installed location. echo " " @@ -15092,7 +15661,10 @@ cc='$cc' cccdlflags='$cccdlflags' ccdlflags='$ccdlflags' ccflags='$ccflags' +ccflags_uselargefiles='$ccflags_uselargefiles' +ccname='$ccname' ccsymbols='$ccsymbols' +ccversion='$ccversion' cf_by='$cf_by' cf_email='$cf_email' cf_time='$cf_time' @@ -15119,10 +15691,10 @@ crosscompile='$crosscompile' cryptlib='$cryptlib' csh='$csh' d_Gconvert='$d_Gconvert' -d_PRIEldbl='$d_PRIEldbl' -d_PRIFldbl='$d_PRIFldbl' -d_PRIGldbl='$d_PRIGldbl' -d_PRIX64='$d_PRIX64' +d_PRIEUldbl='$d_PRIEUldbl' +d_PRIFUldbl='$d_PRIFUldbl' +d_PRIGUldbl='$d_PRIGUldbl' +d_PRIXU64='$d_PRIXU64' d_PRId64='$d_PRId64' d_PRIeldbl='$d_PRIeldbl' d_PRIfldbl='$d_PRIfldbl' @@ -15131,6 +15703,8 @@ d_PRIi64='$d_PRIi64' d_PRIo64='$d_PRIo64' d_PRIu64='$d_PRIu64' d_PRIx64='$d_PRIx64' +d_SCNfldbl='$d_SCNfldbl' +d__fwalk='$d__fwalk' d_access='$d_access' d_accessx='$d_accessx' d_alarm='$d_alarm' @@ -15172,12 +15746,12 @@ d_endnent='$d_endnent' d_endpent='$d_endpent' d_endpwent='$d_endpwent' d_endsent='$d_endsent' -d_endspent='$d_endspent' d_eofnblk='$d_eofnblk' d_eunice='$d_eunice' d_fchmod='$d_fchmod' d_fchown='$d_fchown' d_fcntl='$d_fcntl' +d_fcntl_can_lock='$d_fcntl_can_lock' d_fd_macros='$d_fd_macros' d_fd_set='$d_fd_set' d_fds_bits='$d_fds_bits' @@ -15187,14 +15761,17 @@ d_flock='$d_flock' d_fork='$d_fork' d_fpathconf='$d_fpathconf' d_fpos64_t='$d_fpos64_t' +d_frexpl='$d_frexpl' d_fs_data_s='$d_fs_data_s' d_fseeko='$d_fseeko' d_fsetpos='$d_fsetpos' d_fstatfs='$d_fstatfs' d_fstatvfs='$d_fstatvfs' +d_fsync='$d_fsync' d_ftello='$d_ftello' d_ftime='$d_ftime' d_getcwd='$d_getcwd' +d_getespwnam='$d_getespwnam' d_getfsstat='$d_getfsstat' d_getgrent='$d_getgrent' d_getgrps='$d_getgrps' @@ -15210,6 +15787,7 @@ d_getnbyaddr='$d_getnbyaddr' d_getnbyname='$d_getnbyname' d_getnent='$d_getnent' d_getnetprotos='$d_getnetprotos' +d_getpagsz='$d_getpagsz' d_getpbyname='$d_getpbyname' d_getpbynumber='$d_getpbynumber' d_getpent='$d_getpent' @@ -15219,12 +15797,12 @@ d_getpgrp='$d_getpgrp' d_getppid='$d_getppid' d_getprior='$d_getprior' d_getprotoprotos='$d_getprotoprotos' +d_getprpwnam='$d_getprpwnam' d_getpwent='$d_getpwent' d_getsbyname='$d_getsbyname' d_getsbyport='$d_getsbyport' d_getsent='$d_getsent' d_getservprotos='$d_getservprotos' -d_getspent='$d_getspent' d_getspnam='$d_getspnam' d_gettimeod='$d_gettimeod' d_gnulibc='$d_gnulibc' @@ -15236,6 +15814,8 @@ d_index='$d_index' d_inetaton='$d_inetaton' d_int64_t='$d_int64_t' d_isascii='$d_isascii' +d_isnan='$d_isnan' +d_isnanl='$d_isnanl' d_killpg='$d_killpg' d_lchown='$d_lchown' d_ldbl_dig='$d_ldbl_dig' @@ -15262,6 +15842,7 @@ d_mkstemp='$d_mkstemp' d_mkstemps='$d_mkstemps' d_mktime='$d_mktime' d_mmap='$d_mmap' +d_modfl='$d_modfl' d_mprotect='$d_mprotect' d_msg='$d_msg' d_msg_ctrunc='$d_msg_ctrunc' @@ -15278,6 +15859,7 @@ d_munmap='$d_munmap' d_mymalloc='$d_mymalloc' d_nice='$d_nice' d_nv_preserves_uv='$d_nv_preserves_uv' +d_nv_preserves_uv_bits='$d_nv_preserves_uv_bits' d_off64_t='$d_off64_t' d_old_pthread_create_joinable='$d_old_pthread_create_joinable' d_oldpthreads='$d_oldpthreads' @@ -15285,6 +15867,7 @@ d_oldsock='$d_oldsock' d_open3='$d_open3' d_pathconf='$d_pathconf' d_pause='$d_pause' +d_perl_otherlibdirs='$d_perl_otherlibdirs' d_phostname='$d_phostname' d_pipe='$d_pipe' d_poll='$d_poll' @@ -15308,6 +15891,7 @@ d_rmdir='$d_rmdir' d_safebcpy='$d_safebcpy' d_safemcpy='$d_safemcpy' d_sanemcmp='$d_sanemcmp' +d_sbrkproto='$d_sbrkproto' d_sched_yield='$d_sched_yield' d_scm_rights='$d_scm_rights' d_seekdir='$d_seekdir' @@ -15341,7 +15925,6 @@ d_setrgid='$d_setrgid' d_setruid='$d_setruid' d_setsent='$d_setsent' d_setsid='$d_setsid' -d_setspent='$d_setspent' d_setvbuf='$d_setvbuf' d_sfio='$d_sfio' d_shm='$d_shm' @@ -15355,6 +15938,7 @@ d_sigsetjmp='$d_sigsetjmp' d_socket='$d_socket' d_socklen_t='$d_socklen_t' d_sockpair='$d_sockpair' +d_socks5_init='$d_socks5_init' d_sqrtl='$d_sqrtl' d_statblks='$d_statblks' d_statfs_f_flags='$d_statfs_f_flags' @@ -15362,6 +15946,8 @@ d_statfs_s='$d_statfs_s' d_statvfs='$d_statvfs' d_stdio_cnt_lval='$d_stdio_cnt_lval' d_stdio_ptr_lval='$d_stdio_ptr_lval' +d_stdio_ptr_lval_nochange_cnt='$d_stdio_ptr_lval_nochange_cnt' +d_stdio_ptr_lval_sets_cnt='$d_stdio_ptr_lval_sets_cnt' d_stdio_stream_array='$d_stdio_stream_array' d_stdiobase='$d_stdiobase' d_stdstdio='$d_stdstdio' @@ -15441,6 +16027,7 @@ freetype='$freetype' full_ar='$full_ar' full_csh='$full_csh' full_sed='$full_sed' +gccosandvers='$gccosandvers' gccversion='$gccversion' gidformat='$gidformat' gidsign='$gidsign' @@ -15455,7 +16042,6 @@ h_fcntl='$h_fcntl' h_sysfile='$h_sysfile' hint='$hint' hostcat='$hostcat' -huge='$huge' i16size='$i16size' i16type='$i16type' i32size='$i32size' @@ -15492,6 +16078,7 @@ i_neterrno='$i_neterrno' i_netinettcp='$i_netinettcp' i_niin='$i_niin' i_poll='$i_poll' +i_prot='$i_prot' i_pthread='$i_pthread' i_pwd='$i_pwd' i_rpcsvcdbm='$i_rpcsvcdbm' @@ -15564,15 +16151,16 @@ installvendorarch='$installvendorarch' installvendorbin='$installvendorbin' installvendorlib='$installvendorlib' intsize='$intsize' +issymlink='$issymlink' ivdformat='$ivdformat' ivsize='$ivsize' ivtype='$ivtype' known_extensions='$known_extensions' ksh='$ksh' -large='$large' ld='$ld' lddlflags='$lddlflags' ldflags='$ldflags' +ldflags_uselargefiles='$ldflags_uselargefiles' ldlibpthname='$ldlibpthname' less='$less' lib_ext='$lib_ext' @@ -15585,6 +16173,7 @@ libsfiles='$libsfiles' libsfound='$libsfound' libspath='$libspath' libswanted='$libswanted' +libswanted_uselargefiles='$libswanted_uselargefiles' line='$line' lint='$lint' lkflags='$lkflags' @@ -15613,11 +16202,9 @@ man1ext='$man1ext' man3dir='$man3dir' man3direxp='$man3direxp' man3ext='$man3ext' -medium='$medium' mips_type='$mips_type' mkdir='$mkdir' mmaptype='$mmaptype' -models='$models' modetype='$modetype' more='$more' multiarch='$multiarch' @@ -15636,6 +16223,12 @@ nm_opt='$nm_opt' nm_so_opt='$nm_so_opt' nonxs_ext='$nonxs_ext' nroff='$nroff' +nvEUformat='$nvEUformat' +nvFUformat='$nvFUformat' +nvGUformat='$nvGUformat' +nveformat='$nveformat' +nvfformat='$nvfformat' +nvgformat='$nvgformat' nvsize='$nvsize' nvtype='$nvtype' o_nonblock='$o_nonblock' @@ -15645,6 +16238,7 @@ optimize='$optimize' orderlib='$orderlib' osname='$osname' osvers='$osvers' +otherlibdirs='$otherlibdirs' package='$package' pager='$pager' passcat='$passcat' @@ -15653,6 +16247,7 @@ path_sep='$path_sep' perl5='$perl5' perl='$perl' perladmin='$perladmin' +perllibs='$perllibs' perlpath='$perlpath' pg='$pg' phostname='$phostname' @@ -15678,10 +16273,10 @@ revision='$revision' rm='$rm' rmail='$rmail' runnm='$runnm' -sPRIEldbl='$sPRIEldbl' -sPRIFldbl='$sPRIFldbl' -sPRIGldbl='$sPRIGldbl' -sPRIX64='$sPRIX64' +sPRIEUldbl='$sPRIEUldbl' +sPRIFUldbl='$sPRIFUldbl' +sPRIGUldbl='$sPRIGUldbl' +sPRIXU64='$sPRIXU64' sPRId64='$sPRId64' sPRIeldbl='$sPRIeldbl' sPRIfldbl='$sPRIfldbl' @@ -15690,6 +16285,7 @@ sPRIi64='$sPRIi64' sPRIo64='$sPRIo64' sPRIu64='$sPRIu64' sPRIx64='$sPRIx64' +sSCNfldbl='$sSCNfldbl' sched_yield='$sched_yield' scriptdir='$scriptdir' scriptdirexp='$scriptdirexp' @@ -15724,7 +16320,6 @@ sizesize='$sizesize' sizetype='$sizetype' sleep='$sleep' smail='$smail' -small='$small' so='$so' sockethdr='$sockethdr' socketlib='$socketlib' @@ -15732,7 +16327,6 @@ socksizetype='$socksizetype' sort='$sort' spackage='$spackage' spitshell='$spitshell' -split='$split' src='$src' ssizetype='$ssizetype' startperl='$startperl' @@ -15797,6 +16391,7 @@ usevendorprefix='$usevendorprefix' usevfork='$usevfork' usrinc='$usrinc' uuname='$uuname' +uvXUformat='$uvXUformat' uvoformat='$uvoformat' uvsize='$uvsize' uvtype='$uvtype' @@ -15812,10 +16407,13 @@ vendorlibexp='$vendorlibexp' vendorprefix='$vendorprefix' vendorprefixexp='$vendorprefixexp' version='$version' +versiononly='$versiononly' vi='$vi' voidflags='$voidflags' xlibpth='$xlibpth' xs_apiversion='$xs_apiversion' +yacc='$yacc' +yaccflags='$yaccflags' zcat='$zcat' zip='$zip' EOT @@ -15830,9 +16428,9 @@ echo "CONFIGDOTSH=true" >>config.sh : propagate old symbols if $test -f UU/config.sh; then - UU/oldconfig.sh + UU/oldconfig.sh sed -n 's/^\([a-zA-Z_0-9]*\)=.*/\1/p' config.sh config.sh UU/oldconfig.sh |\ - sort | uniq -u >UU/oldsyms + $sort | $uniq -u >UU/oldsyms set X `cat UU/oldsyms` shift case $# in @@ -15906,7 +16504,7 @@ EOM . UU/myread case "$ans" in y*) - $make depend && echo "Now you must run a $make." + $make depend && echo "Now you must run '$make'." ;; *) echo "You must run '$make depend' then '$make'." diff --git a/contrib/perl5/EXTERN.h b/contrib/perl5/EXTERN.h index 897fae63b078..148055148503 100644 --- a/contrib/perl5/EXTERN.h +++ b/contrib/perl5/EXTERN.h @@ -1,6 +1,6 @@ /* EXTERN.h * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. diff --git a/contrib/perl5/INSTALL b/contrib/perl5/INSTALL index 552c8702013b..dbf6cb5ca182 100644 --- a/contrib/perl5/INSTALL +++ b/contrib/perl5/INSTALL @@ -6,7 +6,7 @@ Install - Build and Installation guide for perl5. First, make sure you are installing an up-to-date version of Perl. If you didn't get your Perl source from CPAN, check the latest version at -. +. The basic steps to build and install perl5 on a Unix system with all the defaults are: @@ -24,6 +24,15 @@ with all the defaults are: Each of these is explained in further detail below. +B: starting from the release 5.6.0 Perl will use a version +scheme where even-numbered subreleases (like 5.6) are stable +maintenance releases and odd-numbered subreleases (like 5.7) are +unstable development releases. Development releases should not be +used in production environments. Fixes and new features are first +carefully tested in development releases and only if they prove +themselves to be worthy will they be migrated to the maintenance +releases. + The above commands will install Perl to /usr/local or /opt, depending on the platform. If that's not okay with you, use @@ -76,7 +85,7 @@ extensions that have not been updated for the new naming convention with: perl Makefile.PL POLLUTE=1 - + Alternatively, you can enable CPP symbol pollution wholesale by building perl itself with: @@ -113,8 +122,42 @@ currently installed modules. =head1 WARNING: This version requires a compiler that supports ANSI C. -If you find that your C compiler is not ANSI-capable, try obtaining -GCC, available from GNU mirrors worldwide (e.g. ftp://ftp.gnu.org/pub/gnu). +Most C compilers are now ANSI-compliant. However, a few current +computers are delivered with an older C compiler expressly for +rebuilding the system kernel, or for some other historical reason. +Alternatively, you may have an old machine which was shipped before +ANSI compliance became widespread. Such compilers are not suitable +for building Perl. + +If you find that your default C compiler is not ANSI-capable, but you +know that an ANSI-capable compiler is installed on your system, you +can tell F to use the correct compiler by means of the +C<-Dcc=> command-line option -- see L<"gcc">. + +If do not have an ANSI-capable compiler there are several avenues open +to you: + +=over 4 + +=item * + +You may try obtaining GCC, available from GNU mirrors worldwide, +listed at . If, rather than +building gcc from source code, you locate a binary version configured +for your platform, be sure that it is compiled for the version of the +operating system that you are using. + +=item * + +You may purchase a commercial ANSI C compiler from your system +supplier or elsewhere. (Or your organization may already have +licensed such software -- ask your colleagues to find out how to +access it.) If there is a README file for your system in the Perl +distribution (for example, F), it may contain advice on +suitable compilers. + +=item * + Another alternative may be to use a tool like ansi2knr to convert the sources back to K&R style, but there is no guarantee this route will get you anywhere, since the prototypes are not the only ANSI features used @@ -125,9 +168,11 @@ run, you may have to run it on a platform where GCC is available, and move the sources back to the platform without GCC. If you succeed in automatically converting the sources to a K&R compatible -form, be sure to email perlbug@perl.com to let us know the steps you +form, be sure to email perlbug@perl.org to let us know the steps you followed. This will enable us to officially support this option. +=back + Although Perl can be compiled using a C++ compiler, the Configure script does not work with some C++ compilers. @@ -219,6 +264,28 @@ For more help on Configure switches, run: sh Configure -h +=head2 Building Perl outside of the source directory + +Sometimes it is desirable to build Perl in a directory different from +where the sources are, for example if you want to keep your sources +read-only, or if you want to share the sources between different binary +architectures. + +Starting from Perl 5.6.1 you can do this (if your file system supports +symbolic links) by + + mkdir /tmp/perl/build/directory + cd /tmp/perl/build/directory + sh /path/to/perl/source/Configure -Dmksymlinks ... + +This will create in /tmp/perl/build/directory a tree of symbolic links +pointing to files in /path/to/perl/source. The original files are left +unaffected. After Configure has finished you can just say + + make all test + +and Perl will be built and tested, all in /tmp/perl/build/directory. + =head2 Common Configure options Configure supports a number of useful options. Run B to @@ -291,7 +358,14 @@ output, you can run sh Configure -des -For my Solaris system, I usually use +Note: for development releases (odd subreleases, like 5.7, as opposed +to maintenance releases which have even subreleases, like 5.6) +if you want to use Configure -d, you will also need to supply -Dusedevel +to Configure, because the default answer to the question "do you really +want to Configure a development version?" is "no". The -Dusedevel +skips that sanity check. + +For example for my Solaris system, I usually use sh Configure -Dprefix=/opt/perl -Doptimize='-xpentium -xO4' -des @@ -461,9 +535,26 @@ network. One way to do that would be something like As a final catch-all, Configure also offers an $otherlibdirs variable. This variable contains a colon-separated list of additional -directories to add to @INC. By default, it will be set to -$prefix/site_perl if Configure detects that you have 5.004-era modules -installed there. However, you can set it to anything you like. +directories to add to @INC. By default, it will be empty. +Perl will search these directories (including architecture and +version-specific subdirectories) for add-on modules and extensions. + +=item APPLLIB_EXP + +There is one other way of adding paths to @INC at perl build time, and +that is by setting the APPLLIB_EXP C pre-processor token to a colon- +separated list of directories, like this + + sh Configure -Accflags='-DAPPLLIB_EXP=\"/usr/libperl\"' + +The directories defined by APPLLIB_EXP get added to @INC I, +ahead of any others, and so provide a way to override the standard perl +modules should you, for example, want to distribute fixes without +touching the perl distribution proper. And, like otherlib dirs, +version and architecture specific subdirectories are also searched, if +present, at run time. Of course, you can still search other @INC +directories ahead of those in APPLLIB_EXP by using any of the standard +run-time methods: $PERLLIB, $PERL5LIB, -I, use lib, etc. =item Man Pages @@ -634,6 +725,52 @@ or by Eventually (by perl v5.6.0) this internal confusion ought to disappear, and these options may disappear as well. +=head2 64 bit support. + +If your platform does not have 64 bits natively, but can simulate them with +compiler flags and/or C or C, you can build a perl that +uses 64 bits. + +There are actually two modes of 64-bitness: the first one is achieved +using Configure -Duse64bitint and the second one using Configure +-Duse64bitall. The difference is that the first one is minimal and +the second one maximal. The first works in more places than the second. + +The C does only as much as is required to get 64-bit +integers into Perl (this may mean, for example, using "long longs") +while your memory may still be limited to 2 gigabytes (because your +pointers could still be 32-bit). Note that the name C<64bitint> does +not imply that your C compiler will be using 64-bit Cs (it might, +but it doesn't have to): the C means that you will be +able to have 64 bits wide scalar values. + +The C goes all the way by attempting to switch also +integers (if it can), longs (and pointers) to being 64-bit. This may +create an even more binary incompatible Perl than -Duse64bitint: the +resulting executable may not run at all in a 32-bit box, or you may +have to reboot/reconfigure/rebuild your operating system to be 64-bit +aware. + +Natively 64-bit systems like Alpha and Cray need neither -Duse64bitint +nor -Duse64bitall. + + NOTE: 64-bit support is still experimental on most platforms. + Existing support only covers the LP64 data model. In particular, the + LLP64 data model is not yet supported. 64-bit libraries and system + APIs on many platforms have not stabilized--your mileage may vary. + +=head2 Long doubles + +In some systems you may be able to use long doubles to enhance the +range and precision of your double precision floating point numbers +(that is, Perl's numbers). Use Configure -Duselongdouble to enable +this support (if it is available). + +=head2 "more bits" + +You can "Configure -Dusemorebits" to turn on both the 64-bit support +and the long double support. + =head2 Selecting File IO mechanisms Previous versions of perl used the standard IO mechanisms as defined in @@ -665,7 +802,7 @@ extension modules or external libraries may not work. This configuration exists to allow these issues to be worked on. This option requires the 'sfio' package to have been built and installed. -A (fairly old) version of sfio is in CPAN. +The latest sfio is available from http://www.research.att.com/sw/tools/sfio/ You select this option by @@ -682,9 +819,6 @@ Configure should detect this problem and warn you about problems with _exit vs. exit. If you have this problem, the fix is to go back to your sfio sources and correct iffe's guess about atexit. -There also might be a more recent release of Sfio that fixes your -problem. - =item 2. Normal stdio IO, but with all IO going through calls to the PerlIO @@ -703,6 +837,13 @@ detect sfio, then this will be the default suggested by Configure. =back +=head2 SOCKS + +Perl can be configured to be 'socksified', that is, to use the SOCKS +TCP/IP proxy protocol library. SOCKS is used to give applications +access to transport layer network proxies. Perl supports only SOCKS +Version 5. You can find more about SOCKS from http://www.socks.nec.com/ + =head2 Dynamic Loading By default, Configure will compile perl to use dynamic loading if @@ -1029,6 +1170,39 @@ you have some libraries under /usr/local/ and others under =back +=head2 Building DB, NDBM, and ODBM interfaces with Berkeley DB 3 + +Perl interface for DB3 is part of Berkeley DB, but if you want to +compile standard Perl DB/ODBM/NDBM interfaces, you must follow +following instructions. + +Berkeley DB3 from Sleepycat Software is by default installed without +DB1 compatibility code (needed for DB_File interface) and without +links to compatibility files. So if you want to use packages written +for DB/ODBM/NDBM interfaces, you need to configure DB3 with +--enable-compat185 (and optionally with --enable-dump185) and create +additional references (suppose you are installing DB3 with +--prefix=/usr): + + ln -s libdb-3.so /usr/lib/libdbm.so + ln -s libdb-3.so /usr/lib/libndbm.so + echo '#define DB_DBM_HSEARCH 1' >dbm.h + echo '#include ' >>dbm.h + install -m 0644 dbm.h /usr/include/dbm.h + install -m 0644 dbm.h /usr/include/ndbm.h + +Optionally, if you have compiled with --enable-compat185 (not needed +for ODBM/NDBM): + + ln -s libdb-3.so /usr/lib/libdb1.so + ln -s libdb-3.so /usr/lib/libdb.so + +ODBM emulation seems not to be perfect, but is quite usable, +using DB 3.1.17: + + lib/odbm.............FAILED at test 9 + Failed 1/64 tests, 98.44% okay + =head2 What if it doesn't work? If you run into problems, try some of the following ideas. @@ -1295,36 +1469,6 @@ numbers and function name may vary in different versions of perl): it might well be a symptom of the gcc "varargs problem". See the previous L<"varargs"> item. -=item Solaris and SunOS dynamic loading - -If you have problems with dynamic loading using gcc on SunOS or -Solaris, and you are using GNU as and GNU ld, you may need to add --B/bin/ (for SunOS) or -B/usr/ccs/bin/ (for Solaris) to your -$ccflags, $ldflags, and $lddlflags so that the system's versions of as -and ld are used. Note that the trailing '/' is required. -Alternatively, you can use the GCC_EXEC_PREFIX -environment variable to ensure that Sun's as and ld are used. Consult -your gcc documentation for further information on the -B option and -the GCC_EXEC_PREFIX variable. - -One convenient way to ensure you are not using GNU as and ld is to -invoke Configure with - - sh Configure -Dcc='gcc -B/usr/ccs/bin/' - -for Solaris systems. For a SunOS system, you must use -B/bin/ -instead. - -Alternatively, recent versions of GNU ld reportedly work if you -include C<-Wl,-export-dynamic> in the ccdlflags variable in -config.sh. - -=item ld.so.1: ./perl: fatal: relocation error: - -If you get this message on SunOS or Solaris, and you're using gcc, -it's probably the GNU as or GNU ld problem in the previous item -L<"Solaris and SunOS dynamic loading">. - =item LD_LIBRARY_PATH If you run into dynamic loading problems, check your setting of @@ -1333,18 +1477,6 @@ Perl library (libperl.a rather than libperl.so) it should build fine with LD_LIBRARY_PATH unset, though that may depend on details of your local set-up. -=item dlopen: stub interception failed - -The primary cause of the 'dlopen: stub interception failed' message is -that the LD_LIBRARY_PATH environment variable includes a directory -which is a symlink to /usr/lib (such as /lib). - -The reason this causes a problem is quite subtle. The file libdl.so.1.0 -actually *only* contains functions which generate 'stub interception -failed' errors! The runtime linker intercepts links to -"/usr/lib/libdl.so.1.0" and links in internal implementation of those -functions instead. [Thanks to Tim Bunce for this explanation.] - =item nm extraction If Configure seems to be having trouble finding library functions, @@ -1518,6 +1650,23 @@ to include the GNU utils before running Configure, or specify the vendor-supplied utilities explicitly to Configure, for example by Configure -Dar=/bin/ar. +=item THIS PACKAGE SEEMS TO BE INCOMPLETE + +The F program has not been able to find all the files which +make up the complete Perl distribution. You may have a damaged source +archive file (in which case you may also have seen messages such as +C and C), or you may have obtained a structurally-sound but +incomplete archive. In either case, try downloading again from the +official site named at the start of this document. If you do find +that any site is carrying a corrupted or incomplete source code +archive, please report it to the site's maintainer. + +=item invalid token: ## + +You are using a non-ANSI-compliant C compiler. See L. + =item Miscellaneous Some additional things that have been reported for either perl4 or perl5: @@ -1616,6 +1765,51 @@ test, it does not necessarily mean you have a broken perl. This test tries to exercise the regular expression subsystem quite thoroughly, and may well be far more demanding than your normal usage. +=item Test failures from lib/ftmp-security saying "system possibly insecure" + +Firstly, test failures from the ftmp-security are not necessarily +serious or indicative of a real security threat. That being said, +they bear investigating. + +The tests may fail for the following reasons. Note that each of the +tests is run both in the building directory and the temporary +directory, as returned by File::Spec->tmpdir(). + +(1) If the directory the tests are being run is owned by somebody else +than the user running the tests, or root (uid 0). This failure can +happen if the Perl source code distribution is unpacked in a way that +the user ids in the distribution package are used as-is. Some tar +programs do this. + +(2) If the directory the test are being run in is writable by group +or by other (remember: with UNIX/POSIX semantics, write access to +a directory means the right to add/remove files in that directory), +and there is no sticky bit set in the directory. 'Sticky bit' is +a feature used in some UNIXes to give extra protection to files: if +the bit is on a directory, no one but the owner (or the root) can remove +that file even if the permissions of the directory would allow file +removal by others. This failure can happen if the permissions in the +directory simply are a bit too liberal for the tests' liking. This +may or may not be a real problem: it depends on the permissions policy +used on this particular directory/project/system/site. This failure +can also happen if the system either doesn't support the sticky bit +(this is the case with many non-UNIX platforms: in principle the +File::Temp should know about these platforms and skip the tests), or +if the system supports the sticky bit but for some reason or reasons +it is not being used. This is for example the case with HP-UX: as of +HP-UX release 11.00, the sticky bit is very much supported, but HP-UX +doesn't use it on its /tmp directory as shipped. Also as with the +permissions, some local policy might dictate that the stickiness is +not used. + +(3) If the system supports the POSIX 'chown giveaway' feature and if +any of the parent directories of the temporary file back to the root +directory are 'unsafe', using the definitions given above in (1) and +(2). + +See the documentation for the File::Temp module for more information +about the various security aspects. + =back =head1 make install @@ -1654,12 +1848,17 @@ anything, you can run make install will install the following: + binaries + perl, perl5.nnn where nnn is the current release number. This will be a link to perl. suidperl, sperl5.nnn If you requested setuid emulation. a2p awk-to-perl translator + + scripts + cppstdin This is used by perl -P, if your cc -E can't read from stdin. c2ph, pstruct Scripts for handling C structures in header files. @@ -1672,13 +1871,21 @@ make install will install the following: pl2pm Convert Perl 4 .pl files to Perl 5 .pm modules pod2html, Converters from perl's pod documentation format pod2latex, to other useful formats. - pod2man, and - pod2text + pod2man, + pod2text, + pod2checker, + pod2select, + pod2usage splain Describe Perl warnings and errors dprofpp Perl code profile post-processor - library files in $privlib and $archlib specified to + library files + + in $privlib and $archlib specified to Configure, usually under /usr/local/lib/perl5/. + + documentation + man pages in $man1dir, usually /usr/local/man/man1. module man pages in $man3dir, usually /usr/local/man/man3. @@ -1687,11 +1894,28 @@ make install will install the following: Installperl will also create the directories listed above in L<"Installation Directories">. -Perl's *.h header files and the libperl.a library are also installed +Perl's *.h header files and the libperl library are also installed under $archlib so that any user may later build new modules, run the optional Perl compiler, or embed the perl interpreter into another program even if the Perl source is no longer available. +Sometimes you only want to install the version-specific parts of the perl +installation. For example, you may wish to install a newer version of +perl alongside an already installed production version of perl without +disabling installation of new modules for the production version. +To only install the version-specific parts of the perl installation, run + + Configure -Dversiononly + +or answer 'y' to the appropriate Configure prompt. Alternatively, +you can just manually run + + ./perl installperl -v + +and skip installman altogether. +See also L<"Maintaining completely separate versions"> for another +approach. + =head1 Coexistence with earlier versions of perl5 In general, you can usually safely upgrade from one version of Perl (e.g. @@ -1878,7 +2102,7 @@ available in TeX format. Type If you have difficulty building perl, and none of the advice in this file helps, and careful reading of the error message and the relevant manual pages on your system doesn't help either, then you should send a message -to either the comp.lang.perl.misc newsgroup or to perlbug@perl.com with +to either the comp.lang.perl.misc newsgroup or to perlbug@perl.org with an accurate description of your problem. Please include the output of the ./myconfig shell script that comes with diff --git a/contrib/perl5/INTERN.h b/contrib/perl5/INTERN.h index 286cc46fd8c4..1b35c135020e 100644 --- a/contrib/perl5/INTERN.h +++ b/contrib/perl5/INTERN.h @@ -1,6 +1,6 @@ /* INTERN.h * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. diff --git a/contrib/perl5/MANIFEST b/contrib/perl5/MANIFEST index 0a4ed093a107..05e3cbcb0c8e 100644 --- a/contrib/perl5/MANIFEST +++ b/contrib/perl5/MANIFEST @@ -12,7 +12,6 @@ Copying The GNU General Public License EXTERN.h Included before foreign .h files INSTALL Detailed installation instructions INTERN.h Included before domestic .h files -MAINTAIN Who maintains which files MANIFEST This list of files Makefile.SH A script that generates Makefile Policy_sh.SH Hold site-wide preferences between Configure runs. @@ -30,24 +29,28 @@ Porting/p4desc Smarter 'p4 describe', outputs diffs for new files Porting/patching.pod How to report changes made to Perl Porting/patchls Flexible patch file listing utility Porting/pumpkin.pod Guidelines and hints for Perl maintainers +Porting/repository.pod How to use the Perl repository README The Instructions README.Y2K Notes about Year 2000 concerns +README.aix Notes about AIX port README.amiga Notes about AmigaOS port README.apollo Notes about Apollo DomainOS port README.beos Notes about BeOS port +README.bs2000 Notes about BS2000 POSIX port README.cygwin Notes about Cygwin port README.dos Notes about dos/djgpp port README.epoc Notes about EPOC port README.hpux Notes about HP-UX port README.hurd Notes about GNU/Hurd port README.machten Notes about Power MachTen port +README.macos Notes about Mac OS (Classic) README.mint Notes about Atari MiNT port README.mpeix Notes about MPE/iX port README.os2 Notes about OS/2 port README.os390 Notes about OS/390 (nee MVS) port README.plan9 Notes about Plan9 port -README.posix-bc Notes about BS2000 POSIX port README.qnx Notes about QNX port +README.solaris Notes about Solaris port README.threads Notes about multithreading README.vmesa Notes about VM/ESA port README.vms Notes about installing the VMS port @@ -69,8 +72,8 @@ configure.com Configure-equivalent for VMS configure.gnu Crude emulation of GNU configure cop.h Control operator header cv.h Code value header -cygwin/cygwin.c Additional code for Cygwin port cygwin/Makefile.SHs Shared library generation for Cygwin port +cygwin/cygwin.c Additional code for Cygwin port cygwin/ld2.in ld wrapper template for Cygwin port cygwin/perlld.in dll generator template for Cygwin port deb.c Debugging routines @@ -83,7 +86,6 @@ doio.c I/O operations doop.c Support code for various operations dosish.h Some defines for MS/DOSish machines dump.c Debugging output -ebcdic.c EBCDIC support routines eg/ADB An adb wrapper to put in your crash dir eg/README Intro to example perl scripts eg/cgi/RunMeFirst Setup script for CGI examples @@ -170,6 +172,7 @@ ext/B/B/Bblock.pm Compiler basic block analysis support ext/B/B/Bytecode.pm Compiler Bytecode backend ext/B/B/C.pm Compiler C backend ext/B/B/CC.pm Compiler CC backend +ext/B/B/Concise.pm Compiler Concise backend ext/B/B/Debug.pm Compiler Debug backend ext/B/B/Deparse.pm Compiler Deparse backend ext/B/B/Disassembler.pm Compiler Disassembler backend @@ -235,9 +238,11 @@ ext/DynaLoader/XSLoader_pm.PL Simple XS Loader perl module ext/DynaLoader/dl_aix.xs AIX implementation ext/DynaLoader/dl_beos.xs BeOS implementation ext/DynaLoader/dl_dld.xs GNU dld style implementation +ext/DynaLoader/dl_dllload.xs S/390 dllload() style implementation ext/DynaLoader/dl_dlopen.xs BSD/SunOS4&5 dlopen() style implementation ext/DynaLoader/dl_dyld.xs NeXT/Apple dyld implementation ext/DynaLoader/dl_hpux.xs HP-UX implementation +ext/DynaLoader/dl_mac.xs MacOS implementation ext/DynaLoader/dl_mpeix.xs MPE/iX implementation ext/DynaLoader/dl_next.xs NeXT implementation ext/DynaLoader/dl_none.xs Stub implementation @@ -246,6 +251,7 @@ ext/DynaLoader/dl_vms.xs VMS implementation ext/DynaLoader/dlutils.c Dynamic loader utilities for dl_*.xs files ext/DynaLoader/hints/aix.pl Hint for DynaLoader for named architecture ext/DynaLoader/hints/linux.pl Hint for DynaLoader for named architecture +ext/DynaLoader/hints/netbsd.pl Hint for DynaLoader for named architecture ext/DynaLoader/hints/openbsd.pl Hint for DynaLoader for named architecture ext/Errno/ChangeLog Errno perl module change log ext/Errno/Errno_pm.PL Errno perl module create script @@ -300,8 +306,8 @@ ext/NDBM_File/NDBM_File.xs NDBM extension external subroutines ext/NDBM_File/hints/cygwin.pl Hint for NDBM_File for named architecture ext/NDBM_File/hints/dec_osf.pl Hint for NDBM_File for named architecture ext/NDBM_File/hints/dynixptx.pl Hint for NDBM_File for named architecture -ext/NDBM_File/hints/solaris.pl Hint for NDBM_File for named architecture ext/NDBM_File/hints/sco.pl Hint for NDBM_File for named architecture +ext/NDBM_File/hints/solaris.pl Hint for NDBM_File for named architecture ext/NDBM_File/hints/svr4.pl Hint for NDBM_File for named architecture ext/NDBM_File/typemap NDBM extension interface types ext/ODBM_File/Makefile.PL ODBM extension makefile writer @@ -333,6 +339,7 @@ ext/POSIX/hints/netbsd.pl Hint for POSIX for named architecture ext/POSIX/hints/next_3.pl Hint for POSIX for named architecture ext/POSIX/hints/openbsd.pl Hint for POSIX for named architecture ext/POSIX/hints/sunos_4.pl Hint for POSIX for named architecture +ext/POSIX/hints/svr4.pl Hint for POSIX for named architecture ext/POSIX/typemap POSIX extension interface types ext/SDBM_File/Makefile.PL SDBM extension makefile writer ext/SDBM_File/SDBM_File.pm SDBM extension Perl module @@ -366,9 +373,9 @@ ext/SDBM_File/typemap SDBM extension interface types ext/Socket/Makefile.PL Socket extension makefile writer ext/Socket/Socket.pm Socket extension Perl module ext/Socket/Socket.xs Socket extension external subroutines -ext/Sys/Hostname/Makefile.PL Sys::Hostname extension makefile writer ext/Sys/Hostname/Hostname.pm Sys::Hostname extension Perl module ext/Sys/Hostname/Hostname.xs Sys::Hostname extension external subroutines +ext/Sys/Hostname/Makefile.PL Sys::Hostname extension makefile writer ext/Sys/Syslog/Makefile.PL Sys::Syslog extension makefile writer ext/Sys/Syslog/Syslog.pm Sys::Syslog extension Perl module ext/Sys/Syslog/Syslog.xs Sys::Syslog extension external subroutines @@ -402,6 +409,7 @@ ext/attrs/Makefile.PL attrs extension makefile writer ext/attrs/attrs.pm attrs extension Perl module ext/attrs/attrs.xs attrs extension external subroutines ext/re/Makefile.PL re extension makefile writer +ext/re/hints/aix.pl Hints for re for named architecture ext/re/hints/mpeix.pl Hints for re for named architecture ext/re/re.pm re extension Perl module ext/re/re.xs re extension external subroutines @@ -478,6 +486,7 @@ hints/newsos4.sh Hints for named architecture hints/next_3.sh Hints for named architecture hints/next_3_0.sh Hints for named architecture hints/next_4.sh Hints for named architecture +hints/nonstopux.sh Hints for named architecture hints/openbsd.sh Hints for named architecture hints/opus.sh Hints for named architecture hints/os2.sh Hints for named architecture @@ -516,6 +525,7 @@ installman Perl script to install man pages for pods installperl Perl script to do "make install" dirty work intrpvar.h Variables held in each interpreter instance iperlsys.h Perl's interface to the system +jpl/ChangeLog Java/Perl Lingo change log jpl/JNI/Changes Java Native Interface changes jpl/JNI/Closer.java Java Native Interface example jpl/JNI/JNI.pm Java Native Interface module @@ -543,12 +553,14 @@ jpl/PerlInterpreter/PerlInterpreter.c Perl interpreter abstraction jpl/PerlInterpreter/PerlInterpreter.h Perl interpreter abstraction jpl/PerlInterpreter/PerlInterpreter.java Perl interpreter abstraction jpl/README JPL instructions +jpl/README.JUST-JNI JPL instructions jpl/SETVARS.PL JPL setup jpl/Sample/Makefile.PL JPL sample makefile generator jpl/Sample/Sample.jpl JPL sample jpl/Test/Makefile.PL JPL tests makefile generator jpl/Test/Test.jpl JPL tests jpl/bin/jpl JPL compiler +jpl/docs/Tutorial.pod Perl and Java Tutorial jpl/get_jdk/README Instructions for using get_jdk.pl jpl/get_jdk/get_jdk.pl JDK download tool jpl/get_jdk/jdk_hosts JDK availability list @@ -567,6 +579,7 @@ lib/CGI/Fast.pm Support for FastCGI (persistent server process) lib/CGI/Pretty.pm Output nicely formatted HTML lib/CGI/Push.pm Support for server push lib/CGI/Switch.pm Simple interface for multiple server types +lib/CGI/Util.pm Utility functions lib/CPAN.pm Interface to Comprehensive Perl Archive Network lib/CPAN/FirstTime.pm Utility for creating CPAN config files lib/CPAN/Nox.pm Runs CPAN while avoiding compiled extensions @@ -610,12 +623,14 @@ lib/File/DosGlob.pm Win32 DOS-globbing module lib/File/Find.pm Routines to do a find lib/File/Path.pm Do things like `mkdir -p' and `rm -r' lib/File/Spec.pm portable operations on file names +lib/File/Spec/Epoc.pm portable operations on EPOC file names lib/File/Spec/Functions.pm Function interface to File::Spec object methods lib/File/Spec/Mac.pm portable operations on Mac file names lib/File/Spec/OS2.pm portable operations on OS2 file names lib/File/Spec/Unix.pm portable operations on Unix file names lib/File/Spec/VMS.pm portable operations on VMS file names lib/File/Spec/Win32.pm portable operations on Win32 file names +lib/File/Temp.pm create safe temporary files and file handles lib/File/stat.pm By-name interface to Perl's builtin stat lib/FileCache.pm Keep more files open than the system permits lib/FileHandle.pm Backward-compatible front end to IO extension @@ -639,6 +654,7 @@ lib/Pod/Find.pm used by pod/splitpod lib/Pod/Functions.pm used by pod/splitpod lib/Pod/Html.pm Convert POD data to HTML lib/Pod/InputObjects.pm Pod-Parser - define objects for input streams +lib/Pod/LaTeX.pm Convert POD data to LaTeX lib/Pod/Man.pm Convert POD data to *roff lib/Pod/ParseUtils.pm Pod-Parser - pod utility functions lib/Pod/Parser.pm Pod-Parser - define base class for parsing POD @@ -646,6 +662,7 @@ lib/Pod/Plainer.pm Pod migration utility module lib/Pod/Select.pm Pod-Parser - select portions of POD docs lib/Pod/Text.pm Pod-Parser - convert POD data to formatted ASCII text lib/Pod/Text/Color.pm Convert POD data to color ASCII text +lib/Pod/Text/Overstrike.pm Convert POD data to formatted overstrike text lib/Pod/Text/Termcap.pm Convert POD data to ASCII text with format escapes lib/Pod/Usage.pm Pod-Parser - print usage messages lib/Search/Dict.pm Perform binary search on dictionaries @@ -677,6 +694,7 @@ lib/Time/tm.pm Internal object for Time::{gm,local}time lib/UNIVERSAL.pm Base class for ALL classes lib/User/grent.pm By-name interface to Perl's builtin getgr* lib/User/pwent.pm By-name interface to Perl's builtin getpw* +lib/Win32.pod Documentation for Win32 extras lib/abbrev.pl An abbreviation table builder lib/assert.pl assertion and panic with stack trace lib/attributes.pm For "sub foo : attrlist" @@ -734,9 +752,11 @@ lib/timelocal.pl Perl library supporting inverse of localtime, gmtime lib/unicode/ArabLink.pl Unicode character database lib/unicode/ArabLnkGrp.pl Unicode character database lib/unicode/ArabShap.txt Unicode character database +lib/unicode/BidiMirr.txt Unicode character database lib/unicode/Bidirectional.pl Unicode character database lib/unicode/Block.pl Unicode character database lib/unicode/Blocks.txt Unicode character database +lib/unicode/CaseFold.txt Unicode character database lib/unicode/Category.pl Unicode character database lib/unicode/CombiningClass.pl Unicode character database lib/unicode/CompExcl.txt Unicode character database @@ -833,29 +853,41 @@ lib/unicode/Index.txt Unicode character database lib/unicode/Is/ASCII.pl Unicode character database lib/unicode/Is/Alnum.pl Unicode character database lib/unicode/Is/Alpha.pl Unicode character database +lib/unicode/Is/BidiAL.pl Unicode character database lib/unicode/Is/BidiAN.pl Unicode character database lib/unicode/Is/BidiB.pl Unicode character database +lib/unicode/Is/BidiBN.pl Unicode character database lib/unicode/Is/BidiCS.pl Unicode character database lib/unicode/Is/BidiEN.pl Unicode character database lib/unicode/Is/BidiES.pl Unicode character database lib/unicode/Is/BidiET.pl Unicode character database lib/unicode/Is/BidiL.pl Unicode character database +lib/unicode/Is/BidiLRE.pl Unicode character database +lib/unicode/Is/BidiLRO.pl Unicode character database +lib/unicode/Is/BidiNSM.pl Unicode character database lib/unicode/Is/BidiON.pl Unicode character database +lib/unicode/Is/BidiPDF.pl Unicode character database lib/unicode/Is/BidiR.pl Unicode character database +lib/unicode/Is/BidiRLE.pl Unicode character database +lib/unicode/Is/BidiRLO.pl Unicode character database lib/unicode/Is/BidiS.pl Unicode character database lib/unicode/Is/BidiWS.pl Unicode character database +lib/unicode/Is/Blank.pl Unicode character database lib/unicode/Is/C.pl Unicode character database lib/unicode/Is/Cc.pl Unicode character database +lib/unicode/Is/Cf.pl Unicode character database lib/unicode/Is/Cn.pl Unicode character database lib/unicode/Is/Cntrl.pl Unicode character database lib/unicode/Is/Co.pl Unicode character database +lib/unicode/Is/Cs.pl Unicode character database lib/unicode/Is/DCcircle.pl Unicode character database lib/unicode/Is/DCcompat.pl Unicode character database lib/unicode/Is/DCfinal.pl Unicode character database lib/unicode/Is/DCfont.pl Unicode character database -lib/unicode/Is/DCinital.pl Unicode character database +lib/unicode/Is/DCfraction.pl Unicode character database lib/unicode/Is/DCinitial.pl Unicode character database lib/unicode/Is/DCisolated.pl Unicode character database +lib/unicode/Is/DCmedial.pl Unicode character database lib/unicode/Is/DCnarrow.pl Unicode character database lib/unicode/Is/DCnoBreak.pl Unicode character database lib/unicode/Is/DCsmall.pl Unicode character database @@ -869,6 +901,35 @@ lib/unicode/Is/DecoCompat.pl Unicode character database lib/unicode/Is/Digit.pl Unicode character database lib/unicode/Is/Graph.pl Unicode character database lib/unicode/Is/L.pl Unicode character database +lib/unicode/Is/LbrkAI.pl Unicode character database +lib/unicode/Is/LbrkAL.pl Unicode character database +lib/unicode/Is/LbrkB2.pl Unicode character database +lib/unicode/Is/LbrkBA.pl Unicode character database +lib/unicode/Is/LbrkBB.pl Unicode character database +lib/unicode/Is/LbrkBK.pl Unicode character database +lib/unicode/Is/LbrkCB.pl Unicode character database +lib/unicode/Is/LbrkCL.pl Unicode character database +lib/unicode/Is/LbrkCM.pl Unicode character database +lib/unicode/Is/LbrkCR.pl Unicode character database +lib/unicode/Is/LbrkEX.pl Unicode character database +lib/unicode/Is/LbrkGL.pl Unicode character database +lib/unicode/Is/LbrkHY.pl Unicode character database +lib/unicode/Is/LbrkID.pl Unicode character database +lib/unicode/Is/LbrkIN.pl Unicode character database +lib/unicode/Is/LbrkIS.pl Unicode character database +lib/unicode/Is/LbrkLF.pl Unicode character database +lib/unicode/Is/LbrkNS.pl Unicode character database +lib/unicode/Is/LbrkNU.pl Unicode character database +lib/unicode/Is/LbrkOP.pl Unicode character database +lib/unicode/Is/LbrkPO.pl Unicode character database +lib/unicode/Is/LbrkPR.pl Unicode character database +lib/unicode/Is/LbrkQU.pl Unicode character database +lib/unicode/Is/LbrkSA.pl Unicode character database +lib/unicode/Is/LbrkSG.pl Unicode character database +lib/unicode/Is/LbrkSP.pl Unicode character database +lib/unicode/Is/LbrkSY.pl Unicode character database +lib/unicode/Is/LbrkXX.pl Unicode character database +lib/unicode/Is/LbrkZW.pl Unicode character database lib/unicode/Is/Ll.pl Unicode character database lib/unicode/Is/Lm.pl Unicode character database lib/unicode/Is/Lo.pl Unicode character database @@ -877,34 +938,54 @@ lib/unicode/Is/Lt.pl Unicode character database lib/unicode/Is/Lu.pl Unicode character database lib/unicode/Is/M.pl Unicode character database lib/unicode/Is/Mc.pl Unicode character database +lib/unicode/Is/Me.pl Unicode character database lib/unicode/Is/Mirrored.pl Unicode character database lib/unicode/Is/Mn.pl Unicode character database lib/unicode/Is/N.pl Unicode character database lib/unicode/Is/Nd.pl Unicode character database +lib/unicode/Is/Nl.pl Unicode character database lib/unicode/Is/No.pl Unicode character database lib/unicode/Is/P.pl Unicode character database +lib/unicode/Is/Pc.pl Unicode character database lib/unicode/Is/Pd.pl Unicode character database lib/unicode/Is/Pe.pl Unicode character database +lib/unicode/Is/Pf.pl Unicode character database +lib/unicode/Is/Pi.pl Unicode character database lib/unicode/Is/Po.pl Unicode character database lib/unicode/Is/Print.pl Unicode character database lib/unicode/Is/Ps.pl Unicode character database lib/unicode/Is/Punct.pl Unicode character database lib/unicode/Is/S.pl Unicode character database lib/unicode/Is/Sc.pl Unicode character database +lib/unicode/Is/Sk.pl Unicode character database lib/unicode/Is/Sm.pl Unicode character database lib/unicode/Is/So.pl Unicode character database lib/unicode/Is/Space.pl Unicode character database +lib/unicode/Is/SpacePerl.pl Unicode character database lib/unicode/Is/SylA.pl Unicode character database +lib/unicode/Is/SylAA.pl Unicode character database +lib/unicode/Is/SylAAI.pl Unicode character database +lib/unicode/Is/SylAI.pl Unicode character database lib/unicode/Is/SylC.pl Unicode character database lib/unicode/Is/SylE.pl Unicode character database +lib/unicode/Is/SylEE.pl Unicode character database lib/unicode/Is/SylI.pl Unicode character database +lib/unicode/Is/SylII.pl Unicode character database +lib/unicode/Is/SylN.pl Unicode character database lib/unicode/Is/SylO.pl Unicode character database +lib/unicode/Is/SylOO.pl Unicode character database lib/unicode/Is/SylU.pl Unicode character database lib/unicode/Is/SylV.pl Unicode character database lib/unicode/Is/SylWA.pl Unicode character database +lib/unicode/Is/SylWAA.pl Unicode character database lib/unicode/Is/SylWC.pl Unicode character database lib/unicode/Is/SylWE.pl Unicode character database +lib/unicode/Is/SylWEE.pl Unicode character database lib/unicode/Is/SylWI.pl Unicode character database +lib/unicode/Is/SylWII.pl Unicode character database +lib/unicode/Is/SylWO.pl Unicode character database +lib/unicode/Is/SylWOO.pl Unicode character database +lib/unicode/Is/SylWU.pl Unicode character database lib/unicode/Is/SylWV.pl Unicode character database lib/unicode/Is/Syllable.pl Unicode character database lib/unicode/Is/Upper.pl Unicode character database @@ -922,17 +1003,18 @@ lib/unicode/Name.pl Unicode character database lib/unicode/Names.txt Unicode character database lib/unicode/NamesList.html Unicode character database lib/unicode/Number.pl Unicode character database -lib/unicode/Props.txt Unicode character database +lib/unicode/PropList.txt Unicode character database lib/unicode/README.Ethiopic Unicode character database +lib/unicode/README.perl Unicode character database lib/unicode/ReadMe.txt Unicode character database info lib/unicode/SpecCase.txt Unicode character database lib/unicode/To/Digit.pl Unicode character database lib/unicode/To/Lower.pl Unicode character database lib/unicode/To/Title.pl Unicode character database lib/unicode/To/Upper.pl Unicode character database -lib/unicode/UCD300.html Unicode character database -lib/unicode/Unicode.300 Unicode character database -lib/unicode/Unicode3.html Unicode character database +lib/unicode/UCD301.html Unicode character database +lib/unicode/UCDFF301.html Unicode character database +lib/unicode/Unicode.301 Unicode character database lib/unicode/mktables.PL Unicode character database generator lib/unicode/syllables.txt Unicode character database lib/utf8.pm Pragma to control Unicode support @@ -991,12 +1073,12 @@ os2/OS2/Process/Makefile.PL system() constants in a module os2/OS2/Process/Process.pm system() constants in a module os2/OS2/Process/Process.xs system() constants in a module os2/OS2/REXX/Changes DLL access module -os2/OS2/REXX/MANIFEST DLL access module os2/OS2/REXX/DLL/Changes DLL access module os2/OS2/REXX/DLL/DLL.pm DLL access module os2/OS2/REXX/DLL/DLL.xs DLL access module os2/OS2/REXX/DLL/MANIFEST DLL access module os2/OS2/REXX/DLL/Makefile.PL DLL access module +os2/OS2/REXX/MANIFEST DLL access module os2/OS2/REXX/Makefile.PL DLL access module os2/OS2/REXX/REXX.pm DLL access module os2/OS2/REXX/REXX.xs DLL access module @@ -1015,6 +1097,7 @@ os2/dl_os2.c Addon for dl_open os2/dlfcn.h Addon for dl_open os2/os2.c Additional code for OS/2 os2/os2.sym Additional symbols to export +os2/os2add.sym Overriding symbols to export os2/os2ish.h Header for OS/2 os2/os2thread.h pthread-like typedefs os2/perl2cmd.pl Corrects installed binaries under OS/2 @@ -1050,27 +1133,29 @@ plan9/plan9.c Plan9 port: Plan9-specific C routines plan9/plan9ish.h Plan9 port: Plan9-specific C header file plan9/setup.rc Plan9 port: script for easy build+install plan9/versnum Plan9 port: script to print version number -pod/Makefile Make pods into something else -pod/Win32.pod Documentation for Win32 extras -pod/buildtoc generate perltoc.pod +pod/Makefile.SH generate Makefile whichs makes pods into something else +pod/buildtoc.PL generate buildtoc which generates perltoc.pod pod/checkpods.PL Tool to check for common errors in pods -pod/perl.pod Top level perl man page +pod/perl.pod Top level perl documentation pod/perl5004delta.pod Changes from 5.003 to 5.004 pod/perl5005delta.pod Changes from 5.004 to 5.005 pod/perlapi.pod Perl API documentation (autogenerated) pod/perlapio.pod IO API info -pod/perlbook.pod Book info +pod/perlbook.pod Perl book information pod/perlboot.pod Beginner's Object-oriented Tutorial pod/perlbot.pod Object-oriented Bag o' Tricks pod/perlcall.pod Callback info +pod/perlclib.pod Internal replacements for standard C library functions pod/perlcompile.pod Info on using the Compiler suite pod/perldata.pod Data structure info pod/perldbmfilter.pod Info about DBM Filters pod/perldebguts.pod Debugger guts info +pod/perldebtut.pod Perl debugging tutorial pod/perldebug.pod Debugger info pod/perldelta.pod Changes since last version pod/perldiag.pod Diagnostic info pod/perldsc.pod Data Structures Cookbook +pod/perlebcdic.pod Considerations for running Perl on EBCDIC platforms pod/perlembed.pod Embedding info pod/perlfaq.pod Frequently Asked Questions, Top Level pod/perlfaq1.pod Frequently Asked Questions, Part 1 @@ -1096,7 +1181,9 @@ pod/perllocale.pod Locale support info pod/perllol.pod How to use lists of lists pod/perlmod.pod Module mechanism info pod/perlmodinstall.pod Installing CPAN Modules +pod/perlmodlib.PL Generate pod/perlmodlib.pod pod/perlmodlib.pod Module policy info +pod/perlnewmod.pod Preparing a new module for distribution pod/perlnumber.pod Semantics of numbers and numeric operations pod/perlobj.pod Object info pod/perlop.pod Operator info @@ -1106,6 +1193,8 @@ pod/perlport.pod Portability guide pod/perlre.pod Regular expression info pod/perlref.pod References info pod/perlreftut.pod Mark's references tutorial +pod/perlrequick.pod Quick start guide for Perl regular expressions +pod/perlretut.pod Tutorial for Perl regular expressions pod/perlrun.pod Execution info pod/perlsec.pod Security info pod/perlstyle.pod Style info @@ -1119,6 +1208,7 @@ pod/perltoot.pod Tom's object-oriented tutorial pod/perltootc.pod Tom's object-oriented tutorial (more on class data) pod/perltrap.pod Trap info pod/perlunicode.pod Unicode support info +pod/perlutil.pod Accompanying utilities explained pod/perlvar.pod Variable info pod/perlxs.pod XS api info pod/perlxstut.pod XS tutorial @@ -1202,17 +1292,21 @@ t/lib/ansicolor.t See if Term::ANSIColor works t/lib/anydbm.t See if AnyDBM_File works t/lib/attrs.t See if attrs works with C t/lib/autoloader.t See if AutoLoader works +t/lib/b.t See if B backends work t/lib/basename.t See if File::Basename works t/lib/bigfloat.t See if bigfloat.pl works t/lib/bigfltpm.t See if BigFloat.pm works t/lib/bigint.t See if bigint.pl works t/lib/bigintpm.t See if BigInt.pm works +t/lib/cgi-esc.t See if CGI.pm works t/lib/cgi-form.t See if CGI.pm works t/lib/cgi-function.t See if CGI.pm works t/lib/cgi-html.t See if CGI.pm works +t/lib/cgi-pretty.t See if CGI.pm works t/lib/cgi-request.t See if CGI.pm works t/lib/charnames.t See if character names work t/lib/checktree.t See if File::CheckTree works +t/lib/class-struct.t See if Class::Struct works t/lib/complex.t See if Math::Complex works t/lib/db-btree.t See if DB_File works t/lib/db-hash.t See if DB_File works @@ -1236,8 +1330,8 @@ t/lib/dprof/test6_v Perl code profiler tests t/lib/dumper-ovl.t See if Data::Dumper works for overloaded data t/lib/dumper.t See if Data::Dumper works t/lib/english.t See if English works -t/lib/env.t See if Env works t/lib/env-array.t See if Env works for arrays +t/lib/env.t See if Env works t/lib/errno.t See if Errno works t/lib/fatal.t See if Fatal works t/lib/fields.t See if base/fields works @@ -1249,6 +1343,10 @@ t/lib/filehand.t See if FileHandle works t/lib/filepath.t See if File::Path works t/lib/filespec.t See if File::Spec works t/lib/findbin.t See if FindBin works +t/lib/ftmp-mktemp.t See if File::Temp works +t/lib/ftmp-posix.t See if File::Temp works +t/lib/ftmp-security.t See if File::Temp works +t/lib/ftmp-tempfile.t See if File::Temp works t/lib/gdbm.t See if GDBM_File works t/lib/getopt.t See if Getopt::Std and Getopt::Long work t/lib/glob-basic.t See if File::Glob works @@ -1258,6 +1356,7 @@ t/lib/glob-taint.t See if File::Glob works t/lib/gol-basic.t See if Getopt::Long works t/lib/gol-compat.t See if Getopt::Long works t/lib/gol-linkage.t See if Getopt::Long works +t/lib/gol-oo.t See if Getopt::Long works t/lib/h2ph.h Test header file for h2ph t/lib/h2ph.pht Generated output from h2ph.h by h2ph, for comparison t/lib/h2ph.t See if h2ph works like it should @@ -1284,6 +1383,7 @@ t/lib/open2.t See if IPC::Open2 works t/lib/open3.t See if IPC::Open3 works t/lib/ops.t See if Opcode works t/lib/parsewords.t See if Text::ParseWords works +t/lib/peek.t See if Devel::Peek works t/lib/ph.t See if h2ph works t/lib/posix.t See if POSIX works t/lib/safe1.t See if Safe works @@ -1291,21 +1391,27 @@ t/lib/safe2.t See if Safe works t/lib/sdbm.t See if SDBM_File works t/lib/searchdict.t See if Search::Dict works t/lib/selectsaver.t See if SelectSaver works +t/lib/selfloader.t See if SelfLoader works t/lib/socket.t See if Socket works t/lib/soundex.t See if Soundex works t/lib/symbol.t See if Symbol works t/lib/syslfs.t See if large files work for sysio +t/lib/syslog.t See if Sys::Syslog works t/lib/textfill.t See if Text::Wrap::fill works t/lib/texttabs.t See if Text::Tabs works t/lib/textwrap.t See if Text::Wrap::wrap works t/lib/thr5005.t Test 5.005-style threading (skipped if no use5005threads) t/lib/tie-push.t Test for Tie::Array +t/lib/tie-refhash.t Test for Tie::RefHash and Tie::RefHash::Nestable +t/lib/tie-splice.t Test for Tie::Array::SPLICE t/lib/tie-stdarray.t Test for Tie::StdArray t/lib/tie-stdhandle.t Test for Tie::StdHandle t/lib/tie-stdpush.t Test for Tie::StdArray +t/lib/tie-substrhash.t Test for Tie::SubstrHash t/lib/timelocal.t See if Time::Local works t/lib/trig.t See if Math::Trig works t/op/64bitint.t See if 64 bit integers work +t/op/anonsub.t See if anonymous subroutines work t/op/append.t See if . works t/op/args.t See if operations on @_ work t/op/arith.t See if arithmetic works @@ -1319,6 +1425,7 @@ t/op/chars.t See if character escapes work t/op/chop.t See if chop works t/op/closure.t See if closures work t/op/cmp.t See if the various string and numeric compare work +t/op/concat.t See if string concatenation works t/op/cond.t See if conditional expressions work t/op/context.t See if context propagation works t/op/defins.t See if auto-insert of defined() works @@ -1347,6 +1454,7 @@ t/op/inc.t See if inc/dec of integers near 32 bit limit work t/op/index.t See if index works t/op/int.t See if int works t/op/join.t See if join works +t/op/length.t See if length works t/op/lex_assign.t See if ops involving lexicals or pad temps work t/op/lfs.t See if large files work for perlio t/op/list.t See if array lists work @@ -1357,6 +1465,7 @@ t/op/method.t See if method calls work t/op/misc.t See if miscellaneous bugs have been fixed t/op/mkdir.t See if mkdir works t/op/my.t See if lexical scoping works +t/op/my_stash.t See if my Package works t/op/nothr5005.t local @_ test which does not work under use5005threads t/op/numconvert.t See if accessing fields does not change numeric values t/op/oct.t See if oct and hex work @@ -1376,7 +1485,9 @@ t/op/recurse.t See if deep recursion works t/op/ref.t See if refs and objects work t/op/regexp.t See if regular expressions work t/op/regexp_noamp.t See if regular expressions work with optimizations +t/op/regmesg.t See if one can get regular expression errors t/op/repeat.t See if x operator works +t/op/reverse.t See if reverse operator works t/op/runlevel.t See if die() works from perl_call_*() t/op/sleep.t See if sleep works t/op/sort.t See if sort works @@ -1399,12 +1510,14 @@ t/op/tr.t See if tr works t/op/undef.t See if undef works t/op/universal.t See if UNIVERSAL class works t/op/unshift.t See if unshift works +t/op/utf8decode.t See if UTF-8 decoding works t/op/vec.t See if vectors work t/op/ver.t See if v-strings and the %v format flag work t/op/wantarray.t See if wantarray works t/op/write.t See if write works t/pod/emptycmd.t Test empty pod directives t/pod/emptycmd.xr Expected results for emptycmd.t +t/pod/find.t See if Pod::Find works t/pod/for.t Test =for directive t/pod/for.xr Expected results for for.t t/pod/headings.t Test =head directives @@ -1432,7 +1545,7 @@ t/pod/podselect.xr Expected results for podselect.t t/pod/special_seqs.t Test "special" interior sequences t/pod/special_seqs.xr Expected results for emptycmd.t t/pod/testcmp.pl Module to compare output against expected results -t/pod/testp2pt.pl Module to test Pod::PlainText for a given file +t/pod/testp2pt.pl Module to test Pod::Text for a given file t/pod/testpchk.pl Module to test Pod::Checker for a given file t/pragma/constant.t See if compile-time constants work t/pragma/diagnostics.t See if diagnostics.pm works @@ -1444,8 +1557,8 @@ t/pragma/strict-refs Tests of "use strict 'refs'" for strict.t t/pragma/strict-subs Tests of "use strict 'subs'" for strict.t t/pragma/strict-vars Tests of "use strict 'vars'" for strict.t t/pragma/strict.t See if strictures work -t/pragma/subs.t See if subroutine pseudo-importation works t/pragma/sub_lval.t See if lvalue subroutines work +t/pragma/subs.t See if subroutine pseudo-importation works t/pragma/utf8.t See if utf8 operations work t/pragma/warn/1global Tests of global warnings for warnings.t t/pragma/warn/2use Tests for "use warnings" for warnings.t @@ -1481,6 +1594,7 @@ t/pragma/warn/universal Tests for universal.c for warnings.t t/pragma/warn/utf8 Tests for utf8.c for warnings.t t/pragma/warn/util Tests for util.c for warnings.t t/pragma/warnings.t See if warning controls work +t/run/runenv.t Test if perl honors its environment variables. taint.c Tainting code thrdvar.h Per-thread variables thread.h Threading header @@ -1496,7 +1610,6 @@ utils/c2ph.PL program to translate dbx stabs to perl utils/dprofpp.PL Perl code profile post-processor utils/h2ph.PL A thing to turn C .h files into perl .ph files utils/h2xs.PL Program to make .xs files from C header files -utils/perlbc.PL Front-end for byte compiler utils/perlbug.PL A simple tool to submit a bug report utils/perlcc.PL Front-end for compiler utils/perldoc.PL A simple tool to find & display perl's documentation @@ -1533,19 +1646,22 @@ vms/perly_c.vms perly.c with fixed declarations for global syms vms/perly_h.vms perly.h with fixed declarations for global syms vms/sockadapt.c glue for SockshShr socket support vms/sockadapt.h glue for SockshShr socket support -vms/subconfigure.com performs compiler checks and writes config.sh, config.h, and descrip.mms vms/test.com DCL driver for regression tests vms/vms.c VMS-specific C code for Perl core vms/vms_yfix.pl convert Unix perly.[ch] to VMS perly_[ch].vms vms/vmsish.h VMS-specific C header for Perl core +vms/vmspipe.com VMS-specific piped command helper script vms/writemain.pl Generate perlmain.c from miniperlmain.c+extensions vos/Changes Changes made to port Perl to the VOS operating system vos/build.cm VOS command macro to build Perl vos/compile_perl.cm VOS command macro to build multiple version of Perl -vos/config.def input for config.pl -vos/config.h config.h for VOS +vos/config.alpha.def definitions used by config.pl +vos/config.alpha.h config.h for use with alpha VOS POSIX.1 support +vos/config.ga.def definitions used by config.pl +vos/config.ga.h config.h for use with generally-available VOS POSIX.1 support vos/config.pl script to convert a config_h.SH to a config.h -vos/config_h.SH_orig config_h.SH at the time config.h was created +vos/configure_perl.cm VOS command macro to configure perl before building +vos/install_perl.cm VOS command macro to install perl after building vos/perl.bind VOS bind control file vos/test_vos_dummies.c Test program for "vos_dummies.c" vos/vos_dummies.c Wrappers to soak up undefined functions @@ -1579,6 +1695,7 @@ win32/perlhost.h Perl "host" implementation win32/perllib.c Win32 port win32/pod.mak Win32 port win32/runperl.c Win32 port +win32/sncfnmcs.pl Win32 port win32/splittree.pl Win32 port win32/vdir.h Perl "host" virtual directory manager win32/vmem.h Perl "host" memory manager diff --git a/contrib/perl5/Makefile.SH b/contrib/perl5/Makefile.SH index 285269de442b..ac5ade430283 100755 --- a/contrib/perl5/Makefile.SH +++ b/contrib/perl5/Makefile.SH @@ -26,6 +26,7 @@ esac linklibperl='$(LIBPERL)' shrpldflags='$(LDDLFLAGS)' ldlibpth='' +DPERL_EXTERNAL_GLOB='-DPERL_EXTERNAL_GLOB' case "$useshrplib" in true) # Prefix all runs of 'miniperl' and 'perl' with @@ -70,12 +71,17 @@ true) *) shrpldflags="$shrpldflags -b noentry" ;; esac - shrpldflags="$shrpldflags $ldflags $libs $cryptlib" + shrpldflags="$shrpldflags $ldflags $perllibs $cryptlib" linklibperl="-L $archlibexp/CORE -L `pwd | sed 's/\/UU$//'` -lperl" ;; hpux*) linklibperl="-L `pwd | sed 's/\/UU$//'` -Wl,+s -Wl,+b$archlibexp/CORE -lperl" ;; + os390*) + shrpldflags='-W l,dll' + linklibperl='libperl.x' + DPERL_EXTERNAL_GLOB='' + ;; esac case "$ldlibpthname" in '') ;; @@ -117,6 +123,24 @@ for f in $nonxs_ext; do nonxs_list="$nonxs_list ext/$f/pm_to_blib" done +# Handle the usage of different yaccs in posix-bc (During Configure we +# us yacc for perly.y and byacc for a2p.y. The makefiles must use the +# same configuration for run_byacc!): +case "$osname" in + posix-bc) + byacc=$yacc + ;; +esac + +# Handle the usage of different yaccs in posix-bc (During Configure we +# us yacc for perly.y and byacc for a2p.y. The makefiles must use the +# same configuration for run_byacc!): +case "$osname" in + posix-bc) + byacc=$yacc + ;; +esac + echo "Extracting Makefile (with variable substitutions)" $spitshell >Makefile <>Makefile <<'!NO!SUBS!' @@ -222,19 +247,21 @@ private = preplibrary lib/ExtUtils/Miniperl.pm lib/Config.pm # Files to be built with variable substitution before miniperl # is available. sh = Makefile.SH cflags.SH config_h.SH makeaperl.SH makedepend.SH \ - makedir.SH myconfig.SH writemain.SH + makedir.SH myconfig.SH writemain.SH pod/Makefile.SH shextract = Makefile cflags config.h makeaperl makedepend \ - makedir myconfig writemain + makedir myconfig writemain pod/Makefile # Files to be built with variable substitution after miniperl is # available. Dependencies handled manually below (for now). pl = pod/pod2html.PL pod/pod2latex.PL pod/pod2man.PL pod/pod2text.PL \ - pod/pod2usage.PL pod/podchecker.PL pod/podselect.PL + pod/pod2usage.PL pod/podchecker.PL pod/podselect.PL \ + pod/buildtoc.PL plextract = pod/pod2html pod/pod2latex pod/pod2man pod/pod2text \ - pod/pod2usage pod/podchecker pod/podselect + pod/pod2usage pod/podchecker pod/podselect \ + pod/buildtoc addedbyconf = UU $(shextract) $(plextract) pstruct @@ -297,14 +324,18 @@ utilities: miniperl lib/Config.pm $(plextract) FORCE # Apparently some makes require an action for the FORCE target. FORCE: @sh -c true +!NO!SUBS! -opmini$(OBJ_EXT): op.c - $(RMS) opmini.c - $(LNS) op.c opmini.c - $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB opmini.c - $(RMS) opmini.c +$spitshell >>Makefile <>Makefile <<'!NO!SUBS!' +miniperlmain$(OBJ_EXT): miniperlmain.c patchlevel.h $(CCCMD) $(PLDLFLAGS) $*.c perlmain.c: miniperlmain.c config.sh $(FIRSTMAKEFILE) @@ -333,7 +364,7 @@ esac case "$osname" in aix) $spitshell >>Makefile <>Makefile <<'!NO!SUBS!' - $(LD) $(SHRPLDFLAGS) -o $@ perl$(OBJ_EXT) $(obj) + $(LD) -o $@ $(SHRPLDFLAGS) perl$(OBJ_EXT) $(obj) !NO!SUBS! case "$osname" in aix) @@ -458,7 +489,7 @@ miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) opmini$(OBJ_EXT) *) $spitshell >>Makefile <<'!NO!SUBS!' miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) opmini$(OBJ_EXT) - $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl \ + $(LDLIBPTH) $(CC) $(CLDFLAGS) -o miniperl \ miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) $(LLIBPERL) $(libs) $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e '' || $(MAKE) minitest !NO!SUBS! @@ -468,16 +499,16 @@ miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) opmini$(OBJ_EXT) $spitshell >>Makefile <<'!NO!SUBS!' perl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs $(PERLEXPORT) - $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) + $(SHRPENV) $(LDLIBPTH) $(CC) -o perl $(CLDFLAGS) $(CCDLFLAGS) perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) pureperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs $(PERLEXPORT) - $(SHRPENV) $(LDLIBPTH) purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) + $(SHRPENV) $(LDLIBPTH) purify $(CC) -o pureperl $(CLDFLAGS) $(CCDLFLAGS) perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) purecovperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs $(PERLEXPORT) - $(SHRPENV) $(LDLIBPTH) purecov $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o purecovperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) + $(SHRPENV) $(LDLIBPTH) purecov $(CC) -o purecovperl $(CLDFLAGS) $(CCDLFLAGS) perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) quantperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs $(PERLEXPORT) - $(SHRPENV) $(LDLIBPTH) quantify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) + $(SHRPENV) $(LDLIBPTH) quantify $(CC) -o quantperl $(CLDFLAGS) $(CCDLFLAGS) perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) # This version, if specified in Configure, does ONLY those scripts which need # set-id emulation. Suidperl must be setuid root. It contains the "taint" @@ -485,7 +516,7 @@ quantperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs # has been invoked correctly. suidperl: $& sperl$(OBJ_EXT) perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs $(PERLEXPORT) - $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o suidperl perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) + $(SHRPENV) $(LDLIBPTH) $(CC) -o suidperl $(CLDFLAGS) $(CCDLFLAGS) perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) !NO!SUBS! @@ -493,7 +524,7 @@ fi $spitshell >>Makefile <<'!NO!SUBS!' -sperl$(OBJ_EXT): perl.c perly.h patchlevel.h $(h) +sperl$(OBJ_EXT): perl.c $(h) $(RMS) sperl.c $(LNS) perl.c sperl.c $(CCCMD) -DIAMSUID sperl.c @@ -531,15 +562,25 @@ extra.pods: miniperl -@rm -f extra.pods -@for x in `grep -l '^=[a-z]' README.* | grep -v README.vms` ; do \ nx=`echo $$x | sed -e "s/README\.//"`; \ - $(LNS) ../$$x "pod/perl"$$nx".pod" ; \ + cd pod ; $(LNS) ../$$x "perl"$$nx".pod" ; cd .. ; \ echo "pod/perl"$$nx".pod" >> extra.pods ; \ done - -@test -f vms/perlvms.pod && $(LNS) ../vms/perlvms.pod pod/perlvms.pod && echo "pod/perlvms.pod" >> extra.pods + -@test -f vms/perlvms.pod && cd pod && $(LNS) ../vms/perlvms.pod perlvms.pod && cd .. && echo "pod/perlvms.pod" >> extra.pods install-strip: $(MAKE) STRIPFLAGS=-s install -install: all install.perl install.man +install: + $(MAKE) install.perl install.man STRIPFLAGS=$(STRIPFLAGS) + +install-verbose: + $(MAKE) install.perl install.man STRIPFLAGS=$(STRIPFLAGS) INSTALLFLAGS=-V + +install-silent: + $(MAKE) install.perl install.man STRIPFLAGS=$(STRIPFLAGS) INSTALLFLAGS=-S + +no-install: + $(MAKE) install.perl install.man STRIPFLAGS=$(STRIPFLAGS) INSTALLFLAGS=-n install.perl: all installperl if [ -n "$(COMPILE)" ]; \ @@ -549,15 +590,15 @@ install.perl: all installperl cd ../pod; $(MAKE) compile; \ else :; \ fi - $(LDLIBPTH) ./perl installperl $(STRIPFLAGS) + $(LDLIBPTH) ./perl installperl $(INSTALLFLAGS) $(STRIPFLAGS) install.man: all installman - $(LDLIBPTH) ./perl installman + $(LDLIBPTH) ./perl installman $(INSTALLFLAGS) # XXX Experimental. Hardwired values, but useful for testing. # Eventually Configure could ask for some of these values. install.html: all installhtml - -@test -f README.vms && $(LNS) ../README.vms vms/README_vms.pod + -@test -f README.vms && cd vms && $(LNS) ../README.vms README_vms.pod && cd .. $(LDLIBPTH) ./perl installhtml \ --podroot=. --podpath=. --recurse \ --htmldir=$(privlib)/html \ @@ -577,7 +618,7 @@ install.html: all installhtml run_byacc: FORCE $(BYACC) -d perly.y - -chmod 664 perly.c + -chmod 664 perly.c perly.h sh $(shellflags) ./perly.fixer y.tab.c perly.c sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ -e 's/y\.tab/perly/g' perly.c >perly.tmp && mv perly.tmp perly.c @@ -624,7 +665,8 @@ AUTOGEN_FILES = keywords.h opcode.h opnames.h pp_proto.h pp.sym proto.h \ pod/perlintern.pod pod/perlapi.pod \ objXSUB.h perlapi.h perlapi.c ext/ByteLoader/byterun.h \ ext/ByteLoader/byterun.c ext/B/B/Asmdata.pm regnodes.h \ - warnings.h lib/warnings.pm + warnings.h lib/warnings.pm \ + vms/perly_c.vms vms/perly_h.vms regen_headers: FORCE -$(CHMOD_W) $(AUTOGEN_FILES) @@ -635,6 +677,14 @@ regen_headers: FORCE -perl regcomp.pl -perl warnings.pl +regen_pods: FORCE + -cd pod; $(LDLIBPTH) make regen_pods + +regen_vms: FORCE + -perl vms/vms_yfix.pl perly.c perly.h vms/perly_c.vms vms/perly_h.vms + +regen_all: regen_headers regen_pods regen_vms + # Extensions: # Names added to $(dynamic_ext) or $(static_ext) or $(nonxs_ext) will # automatically get built. There should ordinarily be no need to change @@ -659,23 +709,29 @@ n_dummy $(nonxs_ext): miniperl preplibrary $(DYNALOADER) FORCE clean: _tidy _mopup -realclean: _cleaner _mopup +realclean: _realcleaner _mopup @echo "Note that make realclean does not delete config.sh or Policy.sh" -clobber: _cleaner _mopup +_clobber: rm -f config.sh cppstdin Policy.sh +clobber: _realcleaner _mopup _clobber + distclean: clobber +# Like distclean but also removes emacs backups and *.orig. +veryclean: _verycleaner _mopup _clobber + -@rm -f Obsolete Wanted + # Do not 'make _mopup' directly. _mopup: rm -f *$(OBJ_EXT) *$(LIB_EXT) all perlmain.c -@test -f extra.pods && rm -f `cat extra.pods` -@test -f vms/README_vms.pod && rm -f vms/README_vms.pod - -rm -f perl.exp ext.libs extra.pods + -rm -f perl.exp ext.libs extra.pods opmini.o -rm -f perl.export perl.dll perl.libexp perl.map perl.def -rm -f perl.loadmap miniperl.loadmap perl.prelmap miniperl.prelmap - rm -f perl suidperl miniperl $(LIBPERL) + rm -f perl suidperl miniperl $(LIBPERL) libperl.* microperl # Do not 'make _tidy' directly. _tidy: @@ -687,16 +743,17 @@ _tidy: done rm -f testcompile compilelog -# Do not 'make _cleaner' directly. -_cleaner: +_cleaner1: -cd os2; rm -f Makefile - -cd pod; $(LDLIBPTH) $(MAKE) realclean - -cd utils; $(LDLIBPTH) $(MAKE) realclean - -cd x2p; $(LDLIBPTH) $(MAKE) realclean + -cd pod; $(LDLIBPTH) $(MAKE) $(CLEAN) + -cd utils; $(LDLIBPTH) $(MAKE) $(CLEAN) + -cd x2p; $(LDLIBPTH) $(MAKE) $(CLEAN) -@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) $(nonxs_ext) ; do \ - $(LDLIBPTH) sh ext/util/make_ext realclean $$x MAKE=$(MAKE) ; \ + $(LDLIBPTH) sh ext/util/make_ext $(CLEAN) $$x MAKE=$(MAKE) ; \ done - rm -f *.orig */*.orig *~ */*~ core core.*perl.*.? *perl.core t/core t/core.perl.*.? t/*perl.core t/misctmp* t/tmp* t/c t/perl .?*.c so_locations $(LIBPERL_NONSHR) $(MINIPERL_NONSHR) + +_cleaner2: + rm -f core core.*perl.*.? *perl.core t/core t/core.perl.*.? t/*perl.core t/misctmp* t/forktmp* t/tmp* t/c t/perl t/rantests .?*.c so_locations $(LIBPERL_NONSHR) $(MINIPERL_NONSHR) rm -rf $(addedbyconf) rm -f $(FIRSTMAKEFILE) $(FIRSTMAKEFILE).old rm -f $(private) @@ -705,14 +762,23 @@ _cleaner: rm -f h2ph.man pstruct rm -rf .config rm -f testcompile compilelog - -rmdir lib/B lib/Data lib/IO/Socket lib/IO + -rmdir lib/B lib/Data lib/IO/Socket lib/IO lib/Sys lib/Thread + +_realcleaner: + @$(LDLIBPTH) $(MAKE) _cleaner1 CLEAN=realclean + @$(LDLIBPTH) $(MAKE) _cleaner2 + +_verycleaner: + @$(LDLIBPTH) $(MAKE) _cleaner1 CLEAN=veryclean + @$(LDLIBPTH) $(MAKE) _cleaner2 + -rm -f *~ *.orig */*~ */*.orig */*/*~ */*/*.orig # The following lint has practically everything turned on. Unfortunately, # you have to wade through a lot of mumbo jumbo that can't be suppressed. # If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message # for that spot. -lint: perly.c $(c) +lint: $(c) lint $(lintflags) $(defs) perly.c $(c) > perl.fuzz # Need to unset during recursion to go out of loop. @@ -750,6 +816,7 @@ test check: test-prep else \ cd t && PERL_SKIP_TTY_TEST=1 $(LDLIBPTH) ./perl TEST; \ fi + @echo "Ran tests" > t/rantests utest ucheck: test-prep if (true /dev/null 2>&1; then \ @@ -768,7 +835,7 @@ minitest: miniperl lib/re.pm @echo "You may see some irrelevant test failures if you have been unable" @echo "to build lib/Config.pm." - cd t && (rm -f perl$(EXE_EXT); $(LNS) ../miniperl$(EXE_EXT) perl$(EXE_EXT)) \ - && $(LDLIBPTH) ./perl TEST base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t .clist @@ -896,6 +975,7 @@ os390|posix-bc) mv -f y.tab.c a2p.c chmod u+w a2p.c sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \ + -e 's|^static void __YY_YACC_MAIN.*BS2000.*|/*static main deleted*/|' \ -e 's/y\.tab/a2p/g' a2p.c >a2p.tmp && mv a2p.tmp a2p.c xxx="$xxx a2p.c" fi diff --git a/contrib/perl5/Policy_sh.SH b/contrib/perl5/Policy_sh.SH index 0d9c1dfbc758..fec18b938572 100755 --- a/contrib/perl5/Policy_sh.SH +++ b/contrib/perl5/Policy_sh.SH @@ -7,18 +7,33 @@ $startsh # # This file was produced by running the Policy_sh.SH script, which # gets its values from config.sh, which is generally produced by -# running Configure. The Policy.sh file gets overwritten each time -# Configure is run. Any variables you add to Policy.sh will be lost -# unless you copy Policy.sh somewhere else before running Configure. +# running Configure. # # The idea here is to distill in one place the common site-wide # "policy" answers (such as installation directories) that are # to be "sticky". If you keep the file Policy.sh around in # the same directory as you are building Perl, then Configure will # (by default) load up the Policy.sh file just before the -# platform-specific hints file. +# platform-specific hints file and rewrite it at the end. +# +# The sequence of events is as follows: +# A: If you are NOT re-using an old config.sh: +# 1. At start-up, Configure loads up the defaults from the +# os-specific hints/osname_osvers.sh file and any previous +# Policy.sh file. +# 2. At the end, Configure runs Policy_sh.SH, which creates +# Policy.sh, overwriting a previous Policy.sh if necessary. +# +# B: If you are re-using an old config.sh: +# 1. At start-up, Configure loads up the defaults from config.sh, +# ignoring any previous Policy.sh file. +# 2. At the end, Configure runs Policy_sh.SH, which creates +# Policy.sh, overwriting a previous Policy.sh if necessary. +# +# Thus the Policy.sh file gets overwritten each time +# Configure is run. Any variables you add to Policy.sh will be lost +# unless you copy Policy.sh somewhere else before running Configure. # - # Allow Configure command-line overrides; usually these won't be # needed, but something like -Dprefix=/test/location can be quite # useful for testing out new versions. @@ -37,16 +52,37 @@ esac case "\$prefix" in '') prefix='$prefix' ;; esac + +# By default, the next three are the same as \$prefix. +# If the user changes \$prefix, and previously \$siteprefix was the +# same as \$prefix, then change \$siteprefix as well. +# Use similar logic for \$vendorprefix and \$installprefix. + case "\$siteprefix" in -'') siteprefix='$siteprefix' ;; +'') if test "$siteprefix" = "$prefix"; then + siteprefix="\$prefix" + else + siteprefix='$siteprefix' + fi + ;; esac case "\$vendorprefix" in -'') vendorprefix='$vendorprefix' ;; +'') if test "$vendorprefix" = "$prefix"; then + vendorprefix="\$prefix" + else + vendorprefix='$vendorprefix' + fi + ;; esac # Where installperl puts things. case "\$installprefix" in -'') installprefix='$installprefix' ;; +'') if test "$installprefix" = "$prefix"; then + installprefix="\$prefix" + else + installprefix='$installprefix' + fi + ;; esac # Installation directives. Note that each one comes in three flavors. diff --git a/contrib/perl5/Porting/Contract b/contrib/perl5/Porting/Contract index cc91af26bca8..2b619fd0ff49 100644 --- a/contrib/perl5/Porting/Contract +++ b/contrib/perl5/Porting/Contract @@ -19,7 +19,7 @@ community, mutual respect, trust, and good-faith cooperation. We recognize that the Perl core, defined as the software distributed with the heart of Perl itself, is a joint project on the part of all of us. ->From time to time, a script, module, or set of modules (hereafter referred +From time to time, a script, module, or set of modules (hereafter referred to simply as a "module") will prove so widely useful and/or so integral to the correct functioning of Perl itself that it should be distributed with Perl core. This should never be done without the author's explicit diff --git a/contrib/perl5/Porting/Glossary b/contrib/perl5/Porting/Glossary index cc66d7041bdd..d32c0a678950 100644 --- a/contrib/perl5/Porting/Glossary +++ b/contrib/perl5/Porting/Glossary @@ -174,7 +174,8 @@ cat (Loc.U): cc (cc.U): This variable holds the name of a command to execute a C compiler which can resolve multiple global references that happen to have the same - name. Usual values are 'cc', 'Mcc', 'cc -M', and 'gcc'. + name. Usual values are 'cc' and 'gcc'. + Fervent ANSI compilers may be called 'c89'. AIX has xlc. cccdlflags (dlsrc.U): This variable contains any special flags that might need to be @@ -192,12 +193,28 @@ ccflags (ccflags.U): This variable contains any additional C compiler flags desired by the user. It is up to the Makefile to use this. +ccflags_uselargefiles (uselfs.U): + This variable contains the compiler flags needed by large file builds + and added to ccflags by hints files. + +ccname (Checkcc.U): + This can set either by hints files or by Configure. If using + gcc, this is gcc, and if not, usually equal to cc, unimpressive, no? + Some platforms, however, make good use of this by storing the + flavor of the C compiler being used here. For example if using + the Sun WorkShop suite, ccname will be 'workshop'. + ccsymbols (Cppsym.U): The variable contains the symbols defined by the C compiler alone. The symbols defined by cpp or by cc when it calls cpp are not in this list, see cppsymbols and cppccsymbols. The list is a space-separated list of symbol=value tokens. +ccversion (Checkcc.U): + This can set either by hints files or by Configure. If using + a (non-gcc) vendor cc, this variable may contain a version for + the compiler. + cf_by (cf_who.U): Login name of the person who ran the Configure script and answered the questions. This is used to tag both config.sh and config_h.SH. @@ -323,6 +340,10 @@ csh (Loc.U): full pathname (if any) of the csh program. After Configure runs, the value is reset to a plain "csh" and is not useful. +d__fwalk (d__fwalk.U): + This variable conditionally defines HAS__FWALK if _fwalk() is + available to apply a function to all the file handles. + d_access (d_access.U): This variable conditionally defines HAS_ACCESS if the access() system call is available to check for access permissions using real IDs. @@ -506,10 +527,6 @@ d_endsent (d_endsent.U): This variable conditionally defines HAS_ENDSERVENT if endservent() is available to close whatever was being used for service queries. -d_endspent (d_endspent.U): - This variable conditionally defines HAS_ENDSPENT if endspent() is - available to finalize the scan of SysV shadow password entries. - d_eofnblk (nblock_io.U): This variable conditionally defines EOF_NONBLOCK if EOF can be seen when reading from a non-blocking I/O source. @@ -532,6 +549,10 @@ d_fcntl (d_fcntl.U): This variable conditionally defines the HAS_FCNTL symbol, and indicates whether the fcntl() function exists +d_fcntl_can_lock (d_fcntl_can_lock.U): + This variable conditionally defines the FCNTL_CAN_LOCK symbol + and indicates whether file locking with fcntl() works. + d_fd_macros (d_fd_set.U): This variable contains the eventual value of the HAS_FD_MACROS symbol, which indicates if your C compiler knows about the macros which @@ -573,6 +594,10 @@ d_fpathconf (d_pathconf.U): d_fpos64_t (d_fpos64_t.U): This symbol will be defined if the C compiler supports fpos64_t. +d_frexpl (d_frexpl.U): + This variable conditionally defines the HAS_FREXPL symbol, which + indicates to the C program that the frexpl() routine is available. + d_fs_data_s (d_fs_data_s.U): This variable conditionally defines the HAS_STRUCT_FS_DATA symbol, which indicates that the struct fs_data is supported. @@ -593,6 +618,10 @@ d_fstatvfs (d_statvfs.U): This variable conditionally defines the HAS_FSTATVFS symbol, which indicates to the C program that the fstatvfs() routine is available. +d_fsync (d_fsync.U): + This variable conditionally defines the HAS_FSYNC symbol, which + indicates to the C program that the fsync() routine is available. + d_ftello (d_ftello.U): This variable conditionally defines the HAS_FTELLO symbol, which indicates to the C program that the ftello() routine is available. @@ -616,6 +645,10 @@ d_getcwd (d_getcwd.U): indicates to the C program that the getcwd() routine is available to get the current working directory. +d_getespwnam (d_getespwnam.U): + This variable conditionally defines HAS_GETESPWNAM if getespwnam() is + available to retrieve enchanced (shadow) password entries by name. + d_getfsstat (d_getfsstat.U): This variable conditionally defines the HAS_GETFSSTAT symbol, which indicates to the C program that the getfsstat() routine is available. @@ -690,6 +723,10 @@ d_getnetprotos (d_getnetprotos.U): prototypes for the various getnet*() functions. See also netdbtype.U for probing for various netdb types. +d_getpagsz (d_getpagsz.U): + This variable conditionally defines HAS_GETPAGESIZE if getpagesize() + is available to get the system page size. + d_getpbyname (d_getprotby.U): This variable conditionally defines the HAS_GETPROTOBYNAME symbol, which indicates to the C program that the @@ -735,6 +772,10 @@ d_getprotoprotos (d_getprotoprotos.U): prototypes for the various getproto*() functions. See also netdbtype.U for probing for various netdb types. +d_getprpwnam (d_getprpwnam.U): + This variable conditionally defines HAS_GETPRPWNAM if getprpwnam() is + available to retrieve protected (shadow) password entries by name. + d_getpwent (d_getpwent.U): This variable conditionally defines the HAS_GETPWENT symbol, which indicates to the C program that the getpwent() routine is available @@ -762,10 +803,6 @@ d_getservprotos (d_getservprotos.U): prototypes for the various getserv*() functions. See also netdbtype.U for probing for various netdb types. -d_getspent (d_getspent.U): - This variable conditionally defines HAS_GETSPENT if getspent() is - available to retrieve SysV shadow password entries sequentially. - d_getspnam (d_getspnam.U): This variable conditionally defines HAS_GETSPNAM if getspnam() is available to retrieve SysV shadow password entries by name. @@ -811,6 +848,14 @@ d_isascii (d_isascii.U): This variable conditionally defines the HAS_ISASCII constant, which indicates to the C program that isascii() is available. +d_isnan (d_isnan.U): + This variable conditionally defines the HAS_ISNAN symbol, which + indicates to the C program that the isnan() routine is available. + +d_isnanl (d_isnanl.U): + This variable conditionally defines the HAS_ISNANL symbol, which + indicates to the C program that the isnanl() routine is available. + d_killpg (d_killpg.U): This variable conditionally defines the HAS_KILLPG symbol, which indicates to the C program that the killpg() routine is available @@ -933,6 +978,10 @@ d_mmap (d_mmap.U): This variable conditionally defines HAS_MMAP if mmap() is available to map a file into memory. +d_modfl (d_modfl.U): + This variable conditionally defines the HAS_MODFL symbol, which + indicates to the C program that the modfl() routine is available. + d_mprotect (d_mprotect.U): This variable conditionally defines HAS_MPROTECT if mprotect() is available to modify the access protection of a memory mapped file. @@ -1003,6 +1052,10 @@ d_nv_preserves_uv (perlxv.U): This variable indicates whether a variable of type nvtype can preserve all the bits a variable of type uvtype. +d_nv_preserves_uv_bits (perlxv.U): + This variable indicates how many of bits type uvtype + a variable nvtype can preserve. + d_off64_t (d_off64_t.U): This symbol will be defined if the C compiler supports off64_t. @@ -1036,6 +1089,11 @@ d_pause (d_pause.U): indicates to the C program that the pause() routine is available to suspend a process until a signal is received. +d_perl_otherlibdirs (otherlibdirs.U): + This variable conditionally defines PERL_OTHERLIBDIRS, which + contains a colon-separated set of paths for the perl binary to + include in @INC. See also otherlibdirs. + d_phostname (d_gethname.U): This variable conditionally defines the HAS_PHOSTNAME symbol, which contains the shell command which, when fed to popen(), may be @@ -1061,28 +1119,34 @@ d_PRId64 (quadfio.U): indiciates that stdio has a symbol to print 64-bit decimal numbers. d_PRIeldbl (longdblfio.U): - This variable conditionally defines the PERL_PRIfldlbl symbol, which + This variable conditionally defines the PERL_PRIfldbl symbol, which indiciates that stdio has a symbol to print long doubles. -d_PRIEldbl (longdblfio.U): - This variable conditionally defines the PERL_PRIfldlbl symbol, which +d_PRIEUldbl (longdblfio.U): + This variable conditionally defines the PERL_PRIfldbl symbol, which indiciates that stdio has a symbol to print long doubles. + The 'U' in the name is to separate this from d_PRIeldbl so that even + case-blind systems can see the difference. d_PRIfldbl (longdblfio.U): - This variable conditionally defines the PERL_PRIfldlbl symbol, which + This variable conditionally defines the PERL_PRIfldbl symbol, which indiciates that stdio has a symbol to print long doubles. -d_PRIFldbl (longdblfio.U): - This variable conditionally defines the PERL_PRIfldlbl symbol, which +d_PRIFUldbl (longdblfio.U): + This variable conditionally defines the PERL_PRIfldbl symbol, which indiciates that stdio has a symbol to print long doubles. + The 'U' in the name is to separate this from d_PRIfldbl so that even + case-blind systems can see the difference. d_PRIgldbl (longdblfio.U): - This variable conditionally defines the PERL_PRIfldlbl symbol, which + This variable conditionally defines the PERL_PRIfldbl symbol, which indiciates that stdio has a symbol to print long doubles. -d_PRIGldbl (longdblfio.U): - This variable conditionally defines the PERL_PRIfldlbl symbol, which +d_PRIGUldbl (longdblfio.U): + This variable conditionally defines the PERL_PRIfldbl symbol, which indiciates that stdio has a symbol to print long doubles. + The 'U' in the name is to separate this from d_PRIgldbl so that even + case-blind systems can see the difference. d_PRIi64 (quadfio.U): This variable conditionally defines the PERL_PRIi64 symbol, which @@ -1101,9 +1165,11 @@ d_PRIx64 (quadfio.U): This variable conditionally defines the PERL_PRIx64 symbol, which indiciates that stdio has a symbol to print 64-bit hexadecimal numbers. -d_PRIX64 (quadfio.U): - This variable conditionally defines the PERL_PRIX64 symbol, which +d_PRIXU64 (quadfio.U): + This variable conditionally defines the PERL_PRIXU64 symbol, which indiciates that stdio has a symbol to print 64-bit hExADECimAl numbers. + The 'U' in the name is to separate this from d_PRIx64 so that even + case-blind systems can see the difference. d_pthread_yield (d_pthread_y.U): This variable conditionally defines the HAS_PTHREAD_YIELD @@ -1185,6 +1251,12 @@ d_sanemcmp (d_sanemcmp.U): the memcpy() routine is available and can be used to compare relative magnitudes of chars with their high bits set. +d_sbrkproto (d_sbrkproto.U): + This variable conditionally defines the HAS_SBRK_PROTO symbol, + which indicates to the C program that the system provides + a prototype for the sbrk() function. Otherwise, it is + up to the program to supply one. + d_sched_yield (d_pthread_y.U): This variable conditionally defines the HAS_SCHED_YIELD symbol if the sched_yield routine is available to yield @@ -1195,6 +1267,10 @@ d_scm_rights (d_socket.U): which indicates that the SCM_RIGHTS is available. #ifdef is not enough because it may be an enum, glibc has been known to do this. +d_SCNfldbl (longdblfio.U): + This variable conditionally defines the PERL_PRIfldbl symbol, which + indiciates that stdio has a symbol to scan long doubles. + d_seekdir (d_readdir.U): This variable conditionally defines HAS_SEEKDIR if seekdir() is available. @@ -1287,6 +1363,11 @@ d_setprior (d_setprior.U): This variable conditionally defines HAS_SETPRIORITY if setpriority() is available to set a process's priority. +d_setproctitle (d_setproctitle.U): + This variable conditionally defines the HAS_SETPROCTITLE symbol, + which indicates to the C program that the setproctitle() routine + is available. + d_setpwent (d_setpwent.U): This variable conditionally defines the HAS_SETPWENT symbol, which indicates to the C program that the setpwent() routine is available @@ -1330,10 +1411,6 @@ d_setsid (d_setsid.U): This variable conditionally defines HAS_SETSID if setsid() is available to set the process group ID. -d_setspent (d_setspent.U): - This variable conditionally defines HAS_SETSPENT if setspent() is - available to initialize the scan of SysV shadow password entries. - d_setvbuf (d_setvbuf.U): This variable conditionally defines the HAS_SETVBUF symbol, which indicates to the C program that the setvbuf() routine is available @@ -1372,6 +1449,11 @@ d_sigaction (d_sigaction.U): This variable conditionally defines the HAS_SIGACTION symbol, which indicates that the Vr4 sigaction() routine is available. +d_sigprocmask (d_sigprocmask.U): + This variable conditionally defines HAS_SIGPROCMASK + if sigprocmask() is available to examine or change the signal mask + of the calling process. + d_sigsetjmp (d_sigsetjmp.U): This variable conditionally defines the HAS_SIGSETJMP symbol, which indicates that the sigsetjmp() routine is available to @@ -1388,6 +1470,10 @@ d_sockpair (d_socket.U): This variable conditionally defines the HAS_SOCKETPAIR symbol, which indicates that the BSD socketpair() is supported. +d_socks5_init (d_socks5_init.U): + This variable conditionally defines the HAS_SOCKS5_INIT symbol, which + indicates to the C program that the socks5_init() routine is available. + d_sqrtl (d_sqrtl.U): This variable conditionally defines the HAS_SQRTL symbol, which indicates to the C program that the sqrtl() routine is available. @@ -1419,6 +1505,15 @@ d_stdio_ptr_lval (d_stdstdio.U): This variable conditionally defines STDIO_PTR_LVALUE if the FILE_ptr macro can be used as an lvalue. +d_stdio_ptr_lval_nochange_cnt (d_stdstdio.U): + This symbol is defined if using the FILE_ptr macro as an lvalue + to increase the pointer by n leaves File_cnt(fp) unchanged. + +d_stdio_ptr_lval_sets_cnt (d_stdstdio.U): + This symbol is defined if using the FILE_ptr macro as an lvalue + to increase the pointer by n has the side effect of decreasing the + value of File_cnt(fp) by n. + d_stdio_stream_array (stdio_streams.U): This variable tells whether there is an array holding the stdio streams. @@ -1474,6 +1569,10 @@ d_strtoll (d_strtoll.U): This variable conditionally defines the HAS_STRTOLL symbol, which indicates to the C program that the strtoll() routine is available. +d_strtoq (d_strtoq.U): + This variable conditionally defines the HAS_STRTOQ symbol, which + indicates to the C program that the strtoq() routine is available. + d_strtoul (d_strtoul.U): This variable conditionally defines the HAS_STRTOUL symbol, which indicates to the C program that the strtoul() routine is available @@ -1782,7 +1881,12 @@ full_sed (Loc_sed.U): can share this executable will have the same full pathname to 'sed.' -gccversion (cc.U): +gccosandvers (gccvers.U): + If GNU cc (gcc) is used, this variable the operating system and + version used to compile the gcc. It is set to '' if not gcc, + or if nothing useful can be parsed as the os version. + +gccversion (gccvers.U): If GNU cc (gcc) is used, this variable holds '1' or '2' to indicate whether the compiler is version 1 or 2. This is used in setting some of the default cflags. It is set to '' if not gcc. @@ -1849,12 +1953,6 @@ hostcat (nis.U): On some systems, such as os390, there may be no equivalent command, in which case this variable is unset. -huge (models.U): - This variable contains a flag which will tell the C compiler and loader - to produce a program running with a huge memory model. If the - huge model is not supported, contains the flag to produce large - model programs. It is up to the Makefile to use this. - i16size (perlxv.U): This variable is the size of an I16 in bytes. @@ -1941,6 +2039,10 @@ i_inttypes (i_inttypes.U): This variable conditionally defines the I_INTTYPES symbol, and indicates whether a C program should include . +i_libutil (i_libutil.U): + This variable conditionally defines the I_LIBUTIL symbol, and indicates + whether a C program should include . + i_limits (i_limits.U): This variable conditionally defines the I_LIMITS symbol, and indicates whether a C program may include to get symbols like WORD_BIT @@ -1997,6 +2099,10 @@ i_poll (i_poll.U): This variable conditionally defines the I_POLL symbol, and indicates whether a C program should include . +i_prot (i_prot.U): + This variable conditionally defines the I_PROT symbol, and indicates + whether a C program should include . + i_pthread (i_pthread.U): This variable conditionally defines the I_PTHREAD symbol, and indicates whether a C program should include . @@ -2342,6 +2448,11 @@ intsize (intsize.U): This variable contains the value of the INTSIZE symbol, which indicates to the C program how many bytes there are in an int. +issymlink (issymlink.U): + This variable holds the test command to test for a symbolic link + (if they are supported). Typical values include 'test -h' and + 'test -L'. + ivdformat (perlxvf.U): This variable contains the format string used for printing a Perl IV as a signed decimal integer. @@ -2360,11 +2471,6 @@ ksh (Loc.U): This variable is defined but not used by Configure. The value is a plain '' and is not useful. -large (models.U): - This variable contains a flag which will tell the C compiler and loader - to produce a program running with a large memory model. It is up to - the Makefile to use this. - ld (dlsrc.U): This variable indicates the program to be used to link libraries for dynamic loading. On some systems, it is 'ld'. @@ -2381,6 +2487,10 @@ ldflags (ccflags.U): This variable contains any additional C loader flags desired by the user. It is up to the Makefile to use this. +ldflags_uselargefiles (uselfs.U): + This variable contains the loader flags needed by large file builds + and added to ldflags by hints files. + ldlibpthname (libperl.U): This variable holds the name of the shared library search path, often LD_LIBRARY_PATH. To get an empty @@ -2433,6 +2543,12 @@ libswanted (Myinit.U): search. The order is chosen to pick up the c library ahead of ucb or bsd libraries for SVR4. +libswanted_uselargefiles (uselfs.U): + This variable contains the libraries needed by large file builds + and added to ldflags by hints files. It is a space separated list + of the library names without the "lib" prefix or any suffix, just + like libswanted.. + line (Loc.U): This variable is defined but not used by Configure. The value is a plain '' and is not useful. @@ -2578,12 +2694,6 @@ Mcc (Loc.U): full pathname (if any) of the Mcc program. After Configure runs, the value is reset to a plain "Mcc" and is not useful. -medium (models.U): - This variable contains a flag which will tell the C compiler and loader - to produce a program running with a medium memory model. If the - medium model is not supported, contains the flag to produce large - model programs. It is up to the Makefile to use this. - mips_type (usrinc.U): This variable holds the environment type for the mips system. Possible values are "BSD 4.3" and "System V". @@ -2598,11 +2708,6 @@ mmaptype (d_mmap.U): (and simultaneously the type of the first argument). It can be 'void *' or 'caddr_t'. -models (models.U): - This variable contains the list of memory models supported by this - system. Possible component values are none, split, unsplit, small, - medium, large, and huge. The component values are space separated. - modetype (modetype.U): This variable defines modetype to be something like mode_t, int, unsigned short, or whatever type is used to declare file @@ -2649,6 +2754,15 @@ n (n.U): command to suppress newline. Otherwise it is null. Correct usage is $echo $n "prompt for a question: $c". +need_va_copy (need_va_copy.U): + This symbol, if defined, indicates that the system stores + the variable argument list datatype, va_list, in a format + that cannot be copied by simple assignment, so that some + other means must be used when copying is required. + As such systems vary in their provision (or non-provision) + of copying mechanisms, handy.h defines a platform- + independent macro, Perl_va_copy(src, dst), to do the job. + netdb_hlen_type (netdbtype.U): This variable holds the type used for the 2nd argument to gethostbyaddr(). Usually, this is int or size_t or unsigned. @@ -2695,6 +2809,30 @@ nroff (Loc.U): full pathname (if any) of the nroff program. After Configure runs, the value is reset to a plain "nroff" and is not useful. +nveformat (perlxvf.U): + This variable contains the format string used for printing + a Perl NV using %e-ish floating point format. + +nvEUformat (perlxvf.U): + This variable contains the format string used for printing + a Perl NV using %E-ish floating point format. + +nvfformat (perlxvf.U): + This variable confains the format string used for printing + a Perl NV using %f-ish floating point format. + +nvFUformat (perlxvf.U): + This variable confains the format string used for printing + a Perl NV using %F-ish floating point format. + +nvgformat (perlxvf.U): + This variable contains the format string used for printing + a Perl NV using %g-ish floating point format. + +nvGUformat (perlxvf.U): + This variable contains the format string used for printing + a Perl NV using %G-ish floating point format. + nvsize (perlxv.U): This variable is the size of an NV in bytes. @@ -2741,6 +2879,16 @@ osvers (Oldconfig.U): same for this package, hints files might just be os_4.0 or os_4.1, etc., not keeping separate files for each little release. +otherlibdirs (otherlibdirs.U): + This variable contains a colon-separated set of paths for the perl + binary to search for additional library files or modules. + These directories will be tacked to the end of @INC. + Perl will automatically search below each path for version- + and architecture-specific directories. See inc_version_list + for more details. + A value of ' ' means 'none' and is used to preserve this value + for the next run through Configure. + package (package.U): This variable contains the name of the package being constructed. It is primarily intended for the use of later Configure units. @@ -2792,6 +2940,10 @@ PERL_VERSION (Oldsyms.U): perladmin (perladmin.U): Electronic mail address of the perl5 administrator. +perllibs (End.U): + The list of libraries needed by Perl only (any libraries needed + by extensions only will by dropped, if using dynamic loading). + perlpath (perlpath.U): This variable contains the eventual value of the PERLPATH symbol, which contains the name of the perl interpreter to be used in @@ -3036,6 +3188,10 @@ sig_num_init (sig_name.U): below. A "ZERO" is prepended to the list, and the list is terminated with a plain 0. +sig_size (sig_name.U): + This variable contains the number of elements of the sig_name + and sig_num arrays, excluding the final NULL entry. + signal_t (d_voidsig.U): This variable holds the type of the signal handler (void or int). @@ -3114,11 +3270,6 @@ smail (Loc.U): This variable is defined but not used by Configure. The value is a plain '' and is not useful. -small (models.U): - This variable contains a flag which will tell the C compiler and loader - to produce a program running with a small memory model. It is up to - the Makefile to use this. - so (so.U): This variable holds the extension used to identify shared libraries (also known as shared objects) on the system. Usually set to 'so'. @@ -3148,12 +3299,6 @@ spitshell (spitshell.U): This variable contains the command necessary to spit out a runnable shell on this system. It is either cat or a grep '-v' for # comments. -split (models.U): - This variable contains a flag which will tell the C compiler and loader - to produce a program that will run in separate I and D space, for those - machines that support separation of instruction and data space. It is - up to the Makefile to use this. - sPRId64 (quadfio.U): This variable, if defined, contains the string used by stdio to format 64-bit decimal numbers (format 'd') for output. @@ -3162,25 +3307,31 @@ sPRIeldbl (longdblfio.U): This variable, if defined, contains the string used by stdio to format long doubles (format 'e') for output. -sPRIEldbl (longdblfio.U): +sPRIEUldbl (longdblfio.U): This variable, if defined, contains the string used by stdio to format long doubles (format 'E') for output. + The 'U' in the name is to separate this from sPRIeldbl so that even + case-blind systems can see the difference. sPRIfldbl (longdblfio.U): This variable, if defined, contains the string used by stdio to format long doubles (format 'f') for output. -sPRIFldbl (longdblfio.U): +sPRIFUldbl (longdblfio.U): This variable, if defined, contains the string used by stdio to format long doubles (format 'F') for output. + The 'U' in the name is to separate this from sPRIfldbl so that even + case-blind systems can see the difference. sPRIgldbl (longdblfio.U): This variable, if defined, contains the string used by stdio to format long doubles (format 'g') for output. -sPRIGldbl (longdblfio.U): +sPRIGUldbl (longdblfio.U): This variable, if defined, contains the string used by stdio to format long doubles (format 'G') for output. + The 'U' in the name is to separate this from sPRIgldbl so that even + case-blind systems can see the difference. sPRIi64 (quadfio.U): This variable, if defined, contains the string used by stdio to @@ -3198,15 +3349,21 @@ sPRIx64 (quadfio.U): This variable, if defined, contains the string used by stdio to format 64-bit hexadecimal numbers (format 'x') for output. -sPRIX64 (quadfio.U): +sPRIXU64 (quadfio.U): This variable, if defined, contains the string used by stdio to format 64-bit hExADECimAl numbers (format 'X') for output. + The 'U' in the name is to separate this from sPRIx64 so that even + case-blind systems can see the difference. src (src.U): This variable holds the path to the package source. It is up to the Makefile to use this variable and set VPATH accordingly to find the sources remotely. +sSCNfldbl (longdblfio.U): + This variable, if defined, contains the string used by stdio to + format long doubles (format 'f') for input. + ssizetype (ssizetype.U): This variable defines ssizetype to be something like ssize_t, long or int. It is used by functions that return a count @@ -3521,7 +3678,11 @@ uvuformat (perlxvf.U): uvxformat (perlxvf.U): This variable contains the format string used for printing - a Perl UV as an unsigned hexadecimal integer. + a Perl UV as an unsigned hexadecimal integer in lowercase abcdef. + +uvXUformat (perlxvf.U): + This variable contains the format string used for printing + a Perl UV as an unsigned hexadecimal integer in uppercase ABCDEF. vendorarch (vendorarch.U): This variable contains the value of the PERL_VENDORARCH symbol. @@ -3583,6 +3744,18 @@ version (patchlevel.U): This is suitable for use as a directory name, and hence is filesystem dependent. +versiononly (versiononly.U): + If set, this symbol indicates that only the version-specific + components of a perl installation should be installed. + This may be useful for making a test installation of a new + version without disturbing the existing installation. + Setting versiononly is equivalent to setting installperl's -v option. + In particular, the non-versioned scripts and programs such as + a2p, c2ph, h2xs, pod2*, and perldoc are not installed + (see INSTALL for a more complete list). Nor are the man + pages installed. + Usually, this is undef. + vi (Loc.U): This variable is defined but not used by Configure. The value is a plain '' and is not useful. diff --git a/contrib/perl5/Porting/config.sh b/contrib/perl5/Porting/config.sh index 3f29888e6c68..297a3e269a3a 100644 --- a/contrib/perl5/Porting/config.sh +++ b/contrib/perl5/Porting/config.sh @@ -8,7 +8,7 @@ # Package name : perl5 # Source directory : . -# Configuration time: Tue Mar 21 23:22:20 EET 2000 +# Configuration time: Sat Mar 3 01:13:55 EET 2001 # Configured by : jhi # Target system : osf1 alpha.hut.fi v4.0 878 alpha @@ -35,10 +35,10 @@ api_subversion='0' api_version='5' api_versionstring='5.005' ar='ar' -archlib='/opt/perl/lib/5.6.0/alpha-dec_osf-thread-multi' -archlibexp='/opt/perl/lib/5.6.0/alpha-dec_osf-thread-multi' +archlib='/opt/perl/lib/5.6.1/alpha-dec_osf-thread' +archlibexp='/opt/perl/lib/5.6.1/alpha-dec_osf-thread' archname64='' -archname='alpha-dec_osf-thread-multi' +archname='alpha-dec_osf-thread' archobjs='' awk='awk' baserev='5.0' @@ -46,7 +46,7 @@ bash='' bin='/opt/perl/bin' bincompat5005='undef' binexp='/opt/perl/bin' -bison='' +bison='bison' byacc='byacc' byteorder='12345678' c='\c' @@ -54,12 +54,15 @@ castflags='0' cat='cat' cc='cc' cccdlflags=' ' -ccdlflags=' -Wl,-rpath,/opt/perl/lib/5.6.0/alpha-dec_osf-thread-multi/CORE' +ccdlflags=' -Wl,-rpath,/opt/perl/lib/5.6.1/alpha-dec_osf-thread/CORE' ccflags='-pthread -std -DLANGUAGE_C' +ccflags_uselargefiles='' +ccname='cc' ccsymbols='__alpha=1 __LANGUAGE_C__=1 __osf__=1 __unix__=1 _LONGLONG=1 _SYSTYPE_BSD=1 SYSTYPE_BSD=1 unix=1' +ccversion='V5.6-082' cf_by='jhi' cf_email='yourname@yourhost.yourplace.com' -cf_time='Tue Mar 21 23:22:20 EET 2000' +cf_time='Sat Mar 3 01:13:55 EET 2001' charsize='1' chgrp='' chmod='' @@ -83,10 +86,10 @@ crosscompile='undef' cryptlib='' csh='csh' d_Gconvert='gcvt((x),(n),(b))' -d_PRIEldbl='define' -d_PRIFldbl='define' -d_PRIGldbl='define' -d_PRIX64='define' +d_PRIEUldbl='define' +d_PRIFUldbl='define' +d_PRIGUldbl='define' +d_PRIXU64='define' d_PRId64='define' d_PRIeldbl='define' d_PRIfldbl='define' @@ -95,6 +98,8 @@ d_PRIi64='define' d_PRIo64='define' d_PRIu64='define' d_PRIx64='define' +d_SCNfldbl='define' +d__fwalk='undef' d_access='define' d_accessx='undef' d_alarm='define' @@ -136,12 +141,12 @@ d_endnent='define' d_endpent='define' d_endpwent='define' d_endsent='define' -d_endspent='undef' d_eofnblk='define' d_eunice='undef' d_fchmod='define' d_fchown='define' d_fcntl='define' +d_fcntl_can_lock='define' d_fd_macros='define' d_fd_set='define' d_fds_bits='define' @@ -151,14 +156,17 @@ d_flock='define' d_fork='define' d_fpathconf='define' d_fpos64_t='undef' +d_frexpl='define' d_fs_data_s='undef' d_fseeko='undef' d_fsetpos='define' d_fstatfs='define' d_fstatvfs='define' +d_fsync='define' d_ftello='undef' d_ftime='undef' d_getcwd='define' +d_getespwnam='undef' d_getfsstat='define' d_getgrent='define' d_getgrps='define' @@ -174,6 +182,7 @@ d_getnbyaddr='define' d_getnbyname='define' d_getnent='define' d_getnetprotos='define' +d_getpagsz='define' d_getpbyname='define' d_getpbynumber='define' d_getpent='define' @@ -183,12 +192,12 @@ d_getpgrp='define' d_getppid='define' d_getprior='define' d_getprotoprotos='define' +d_getprpwnam='undef' d_getpwent='define' d_getsbyname='define' d_getsbyport='define' d_getsent='define' d_getservprotos='define' -d_getspent='undef' d_getspnam='undef' d_gettimeod='define' d_gnulibc='undef' @@ -200,6 +209,8 @@ d_index='undef' d_inetaton='define' d_int64_t='undef' d_isascii='define' +d_isnan='define' +d_isnanl='define' d_killpg='define' d_lchown='define' d_ldbl_dig='define' @@ -226,6 +237,7 @@ d_mkstemp='define' d_mkstemps='undef' d_mktime='define' d_mmap='define' +d_modfl='define' d_mprotect='define' d_msg='define' d_msg_ctrunc='define' @@ -242,6 +254,7 @@ d_munmap='define' d_mymalloc='undef' d_nice='define' d_nv_preserves_uv='undef' +d_nv_preserves_uv_bits='53' d_off64_t='undef' d_old_pthread_create_joinable='undef' d_oldpthreads='undef' @@ -249,6 +262,7 @@ d_oldsock='undef' d_open3='define' d_pathconf='define' d_pause='define' +d_perl_otherlibdirs='undef' d_phostname='undef' d_pipe='define' d_poll='define' @@ -272,6 +286,7 @@ d_rmdir='define' d_safebcpy='define' d_safemcpy='undef' d_sanemcmp='define' +d_sbrkproto='define' d_sched_yield='define' d_scm_rights='define' d_seekdir='define' @@ -295,6 +310,7 @@ d_setpgid='define' d_setpgrp2='undef' d_setpgrp='define' d_setprior='define' +d_setproctitle='undef' d_setpwent='define' d_setregid='define' d_setresgid='undef' @@ -304,7 +320,6 @@ d_setrgid='define' d_setruid='define' d_setsent='define' d_setsid='define' -d_setspent='undef' d_setvbuf='define' d_sfio='undef' d_shm='define' @@ -318,6 +333,7 @@ d_sigsetjmp='define' d_socket='define' d_socklen_t='undef' d_sockpair='define' +d_socks5_init='undef' d_sqrtl='define' d_statblks='define' d_statfs_f_flags='define' @@ -325,6 +341,8 @@ d_statfs_s='define' d_statvfs='define' d_stdio_cnt_lval='define' d_stdio_ptr_lval='define' +d_stdio_ptr_lval_nochange_cnt='define' +d_stdio_ptr_lval_sets_cnt='undef' d_stdio_stream_array='define' d_stdiobase='define' d_stdstdio='define' @@ -404,6 +422,7 @@ freetype='void' full_ar='/usr/bin/ar' full_csh='/usr/bin/csh' full_sed='/usr/bin/sed' +gccosandvers='' gccversion='' gidformat='"u"' gidsign='1' @@ -418,7 +437,6 @@ h_fcntl='false' h_sysfile='true' hint='recommended' hostcat='cat /etc/hosts' -huge='' i16size='2' i16type='short' i32size='4' @@ -441,6 +459,7 @@ i_grp='define' i_iconv='define' i_ieeefp='undef' i_inttypes='undef' +i_libutil='undef' i_limits='define' i_locale='define' i_machcthr='undef' @@ -454,6 +473,7 @@ i_neterrno='undef' i_netinettcp='define' i_niin='define' i_poll='define' +i_prot='define' i_pthread='define' i_pwd='define' i_rpcsvcdbm='undef' @@ -509,44 +529,46 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='/opt/perl/lib/5.6.0/alpha-dec_osf-thread-multi' +installarchlib='/opt/perl/lib/5.6.1/alpha-dec_osf-thread' installbin='/opt/perl/bin' installman1dir='/opt/perl/man/man1' installman3dir='/opt/perl/man/man3' installprefix='/opt/perl' installprefixexp='/opt/perl' -installprivlib='/opt/perl/lib/5.6.0' +installprivlib='/opt/perl/lib/5.6.1' installscript='/opt/perl/bin' -installsitearch='/opt/perl/lib/site_perl/5.6.0/alpha-dec_osf-thread-multi' +installsitearch='/opt/perl/lib/site_perl/5.6.1/alpha-dec_osf-thread' installsitebin='/opt/perl/bin' -installsitelib='/opt/perl/lib/site_perl/5.6.0' +installsitelib='/opt/perl/lib/site_perl/5.6.1' installstyle='lib' installusrbinperl='define' installvendorarch='' installvendorbin='' installvendorlib='' intsize='4' +issymlink='-h' ivdformat='"ld"' ivsize='8' ivtype='long' known_extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob GDBM_File IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Sys/Hostname Sys/Syslog Thread attrs re' ksh='' -large='' ld='ld' lddlflags='-shared -expect_unresolved "*" -msym -std -s' ldflags='' +ldflags_uselargefiles='' ldlibpthname='LD_LIBRARY_PATH' less='less' lib_ext='.a' libc='/usr/shlib/libc.so' libperl='libperl.so' libpth='/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /var/shlib' -libs='-lgdbm -ldbm -ldb -lm -liconv -lpthread -lexc' +libs='-lgdbm -ldbm -ldb -lm -liconv -lutil -lpthread -lexc' libsdirs=' /usr/shlib /usr/ccs/lib' -libsfiles=' libgdbm.so libdbm.a libdb.so libm.so libiconv.so libpthread.so libexc.so' -libsfound=' /usr/shlib/libgdbm.so /usr/ccs/lib/libdbm.a /usr/shlib/libdb.so /usr/shlib/libm.so /usr/shlib/libiconv.so /usr/shlib/libpthread.so /usr/shlib/libexc.so' +libsfiles=' libgdbm.so libdbm.a libdb.so libm.so libiconv.so libutil.a libpthread.so libexc.so' +libsfound=' /usr/shlib/libgdbm.so /usr/ccs/lib/libdbm.a /usr/shlib/libdb.so /usr/shlib/libm.so /usr/shlib/libiconv.so /usr/ccs/lib/libutil.a /usr/shlib/libpthread.so /usr/shlib/libexc.so' libspath=' /usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /var/shlib' -libswanted='sfio socket bind inet nsl nm gdbm dbm db malloc dld ld sun m cposix posix ndir dir crypt sec ucb BSD x iconv pthread exc' +libswanted='sfio socket bind inet nsl nm gdbm dbm db malloc dld ld sun m cposix posix ndir dir crypt sec ucb BSD x iconv util pthread exc' +libswanted_uselargefiles='' line='' lint='' lkflags='' @@ -575,11 +597,9 @@ man1ext='1' man3dir='/opt/perl/man/man3' man3direxp='/opt/perl/man/man3' man3ext='3' -medium='' mips_type='' mkdir='mkdir' mmaptype='void *' -models='none' modetype='mode_t' more='more' multiarch='undef' @@ -598,6 +618,12 @@ nm_opt='-p' nm_so_opt='' nonxs_ext='Errno' nroff='nroff' +nvEUformat='"E"' +nvFUformat='"F"' +nvGUformat='"G"' +nveformat='"e"' +nvfformat='"f"' +nvgformat='"g"' nvsize='8' nvtype='double' o_nonblock='O_NONBLOCK' @@ -607,6 +633,7 @@ optimize='-O' orderlib='false' osname='dec_osf' osvers='4.0' +otherlibdirs=' ' package='perl5' pager='/c/bin/less' passcat='cat /etc/passwd' @@ -615,6 +642,7 @@ path_sep=':' perl5='/u/vieraat/vieraat/jhi/Perl/bin/perl' perl='' perladmin='yourname@yourhost.yourplace.com' +perllibs='-lm -liconv -lutil -lpthread -lexc' perlpath='/opt/perl/bin/perl' pg='pg' phostname='' @@ -625,8 +653,8 @@ pmake='' pr='' prefix='/opt/perl' prefixexp='/opt/perl' -privlib='/opt/perl/lib/5.6.0' -privlibexp='/opt/perl/lib/5.6.0' +privlib='/opt/perl/lib/5.6.1' +privlibexp='/opt/perl/lib/5.6.1' prototype='define' ptrsize='8' quadkind='2' @@ -640,10 +668,10 @@ revision='5' rm='rm' rmail='' runnm='true' -sPRIEldbl='"E"' -sPRIFldbl='"F"' -sPRIGldbl='"G"' -sPRIX64='"lX"' +sPRIEUldbl='"E"' +sPRIFUldbl='"F"' +sPRIGUldbl='"G"' +sPRIXU64='"lX"' sPRId64='"ld"' sPRIeldbl='"e"' sPRIfldbl='"f"' @@ -652,6 +680,7 @@ sPRIi64='"li"' sPRIo64='"lo"' sPRIu64='"lu"' sPRIx64='"lx"' +sSCNfldbl='"f"' sched_yield='sched_yield()' scriptdir='/opt/perl/bin' scriptdirexp='/opt/perl/bin' @@ -673,20 +702,19 @@ sig_name_init='"ZERO", "HUP", "INT", "QUIT", "ILL", "TRAP", "ABRT", "EMT", "FPE" sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 6 6 16 20 23 23 23 29 48 ' sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 6, 6, 16, 20, 23, 23, 23, 29, 48, 0' signal_t='void' -sitearch='/opt/perl/lib/site_perl/5.6.0/alpha-dec_osf-thread-multi' -sitearchexp='/opt/perl/lib/site_perl/5.6.0/alpha-dec_osf-thread-multi' +sitearch='/opt/perl/lib/site_perl/5.6.1/alpha-dec_osf-thread' +sitearchexp='/opt/perl/lib/site_perl/5.6.1/alpha-dec_osf-thread' sitebin='/opt/perl/bin' sitebinexp='/opt/perl/bin' -sitelib='/opt/perl/lib/site_perl/5.6.0' +sitelib='/opt/perl/lib/site_perl/5.6.1' sitelib_stem='/opt/perl/lib/site_perl' -sitelibexp='/opt/perl/lib/site_perl/5.6.0' +sitelibexp='/opt/perl/lib/site_perl/5.6.1' siteprefix='/opt/perl' siteprefixexp='/opt/perl' sizesize='8' sizetype='size_t' sleep='' smail='' -small='' so='so' sockethdr='' socketlib='' @@ -694,8 +722,7 @@ socksizetype='int' sort='sort' spackage='Perl5' spitshell='cat' -split='' -src='.' +src='/m/fs/work/work/permanent/perl/pp4/maint-5.6/perl' ssizetype='ssize_t' startperl='#!/opt/perl/bin/perl' startsh='#!/bin/sh' @@ -709,7 +736,7 @@ stdio_ptr='((fp)->_ptr)' stdio_stream_array='_iob' strings='/usr/include/string.h' submit='' -subversion='0' +subversion='1' sysman='/usr/man/man1' tail='' tar='' @@ -737,15 +764,15 @@ uidtype='uid_t' uname='uname' uniq='uniq' uquadtype='unsigned long' -use5005threads='undef' +use5005threads='define' use64bitall='define' use64bitint='define' usedl='define' -useithreads='define' +useithreads='undef' uselargefiles='define' uselongdouble='undef' usemorebits='undef' -usemultiplicity='define' +usemultiplicity='undef' usemymalloc='n' usenm='true' useopcode='true' @@ -759,6 +786,7 @@ usevendorprefix='undef' usevfork='false' usrinc='/usr/include' uuname='' +uvXUformat='"lX"' uvoformat='"lo"' uvsize='8' uvtype='unsigned long' @@ -773,31 +801,36 @@ vendorlib_stem='' vendorlibexp='' vendorprefix='' vendorprefixexp='' -version='5.6.0' +version='5.6.1' +versiononly='undef' vi='' voidflags='15' xlibpth='/usr/lib/386 /lib/386' -xs_apiversion='5.6.0' +xs_apiversion='5.6.1' +yacc='/u/vieraat/vieraat/jhi/Perl/bin/byacc' +yaccflags='' zcat='' zip='zip' # Configure command line arguments. -config_arg0='Configure' -config_args='-Dprefix=/opt/perl -Doptimize=-O -Dusethreads -Duse64bitint -Duselargefiles -Dcf_by=yourname -Dcf_email=yourname@yourhost.yourplace.com -Dperladmin=yourname@yourhost.yourplace.com -Dmydomain=.yourplace.com -Dmyhostname=yourhost -dE' -config_argc=11 +config_arg0='./Configure' +config_args='-Dprefix=/opt/perl -Doptimize=-O -Dusethreads -Duse5005threads -Duse64bitint -Duselargefiles -Dcf_by=yourname -Dcf_email=yourname@yourhost.yourplace.com -Dperladmin=yourname@yourhost.yourplace.com -Dmydomain=.yourplace.com -Dmyhostname=yourhost -dE -Dusedevel' +config_argc=13 config_arg1='-Dprefix=/opt/perl' config_arg2='-Doptimize=-O' config_arg3='-Dusethreads' -config_arg4='-Duse64bitint' -config_arg5='-Duselargefiles' -config_arg6='-Dcf_by=yourname' -config_arg7='-Dcf_email=yourname@yourhost.yourplace.com' -config_arg8='-Dperladmin=yourname@yourhost.yourplace.com' -config_arg9='-Dmydomain=.yourplace.com' -config_arg10='-Dmyhostname=yourhost' -config_arg11='-dE' +config_arg4='-Duse5005threads' +config_arg5='-Duse64bitint' +config_arg6='-Duselargefiles' +config_arg7='-Dcf_by=yourname' +config_arg8='-Dcf_email=yourname@yourhost.yourplace.com' +config_arg9='-Dperladmin=yourname@yourhost.yourplace.com' +config_arg10='-Dmydomain=.yourplace.com' +config_arg11='-Dmyhostname=yourhost' +config_arg12='-dE' +config_arg13='-Dusedevel' PERL_REVISION=5 PERL_VERSION=6 -PERL_SUBVERSION=0 +PERL_SUBVERSION=1 PERL_API_REVISION=5 PERL_API_VERSION=5 PERL_API_SUBVERSION=0 diff --git a/contrib/perl5/Porting/config_H b/contrib/perl5/Porting/config_H index c80ebaffe0e3..311fd91524c7 100644 --- a/contrib/perl5/Porting/config_H +++ b/contrib/perl5/Porting/config_H @@ -17,7 +17,7 @@ /* * Package name : perl5 * Source directory : . - * Configuration time: Tue Mar 21 23:22:20 EET 2000 + * Configuration time: Sat Mar 3 01:13:55 EET 2001 * Configured by : jhi * Target system : osf1 alpha.hut.fi v4.0 878 alpha */ @@ -224,17 +224,6 @@ */ #define HAS_GETPGID /**/ -/* HAS_GETPGRP: - * This symbol, if defined, indicates that the getpgrp routine is - * available to get the current process group. - */ -/* USE_BSD_GETPGRP: - * This symbol, if defined, indicates that getpgrp needs one - * arguments whereas USG one needs none. - */ -#define HAS_GETPGRP /**/ -/*#define USE_BSD_GETPGRP / **/ - /* HAS_GETPGRP2: * This symbol, if defined, indicates that the getpgrp2() (as in DG/UX) * routine is available to get the current process group. @@ -489,18 +478,6 @@ */ #define HAS_SETPGID /**/ -/* HAS_SETPGRP: - * This symbol, if defined, indicates that the setpgrp routine is - * available to set the current process group. - */ -/* USE_BSD_SETPGRP: - * This symbol, if defined, indicates that setpgrp needs two - * arguments whereas USG one needs none. See also HAS_SETPGID - * for a POSIX interface. - */ -#define HAS_SETPGRP /**/ -#define USE_BSD_SETPGRP /**/ - /* HAS_SETPGRP2: * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX) * routine is available to set the current process group. @@ -984,12 +961,6 @@ */ #define SH_PATH "/bin/sh" /**/ -/* STDCHAR: - * This symbol is defined to be the type of char used in stdio.h. - * It has the values "unsigned char" or "char". - */ -#define STDCHAR unsigned char /**/ - /* CROSSCOMPILE: * This symbol, if defined, signifies that we our * build process is a cross-compilation. @@ -1092,8 +1063,8 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "/opt/perl/lib/5.6.0/alpha-dec_osf-thread-multi" /**/ -#define ARCHLIB_EXP "/opt/perl/lib/5.6.0/alpha-dec_osf-thread-multi" /**/ +#define ARCHLIB "/opt/perl/lib/5.6.1/alpha-dec_osf-thread" /**/ +#define ARCHLIB_EXP "/opt/perl/lib/5.6.1/alpha-dec_osf-thread" /**/ /* ARCHNAME: * This symbol holds a string representing the architecture name. @@ -1101,7 +1072,7 @@ * where library files may be held under a private library, for * instance. */ -#define ARCHNAME "alpha-dec_osf-thread-multi" /**/ +#define ARCHNAME "alpha-dec_osf-thread" /**/ /* HAS_ATOLF: * This symbol, if defined, indicates that the atolf routine is @@ -1184,21 +1155,21 @@ * This macro surrounds its token with double quotes. */ #if 42 == 1 -# define CAT2(a,b) a/**/b -# define STRINGIFY(a) "a" +#define CAT2(a,b) a/**/b +#define STRINGIFY(a) "a" /* If you can get stringification with catify, tell me how! */ #endif #if 42 == 42 -# define PeRl_CaTiFy(a, b) a ## b -# define PeRl_StGiFy(a) #a +#define PeRl_CaTiFy(a, b) a ## b +#define PeRl_StGiFy(a) #a /* the additional level of indirection enables these macros to be * used as arguments to other macros. See K&R 2nd ed., page 231. */ -# define CAT2(a,b) PeRl_CaTiFy(a,b) -# define StGiFy(a) PeRl_StGiFy(a) -# define STRINGIFY(a) PeRl_StGiFy(a) +#define CAT2(a,b) PeRl_CaTiFy(a,b) +#define StGiFy(a) PeRl_StGiFy(a) +#define STRINGIFY(a) PeRl_StGiFy(a) #endif #if 42 != 1 && 42 != 42 -#include "Bletch: How does this C preprocessor catenate tokens?" +# include "Bletch: How does this C preprocessor catenate tokens?" #endif /* CPPSTDIN: @@ -1328,23 +1299,30 @@ */ #define HAS_ENDSERVENT /**/ -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. - */ -/*#define HAS_ENDSPENT / **/ - /* HAS_FD_SET: * This symbol, when defined, indicates presence of the fd_set typedef * in */ #define HAS_FD_SET /**/ +/* FLEXFILENAMES: + * This symbol, if defined, indicates that the system supports filenames + * longer than 14 characters. + */ +#define FLEXFILENAMES /**/ + /* HAS_FPOS64_T: * This symbol will be defined if the C compiler supports fpos64_t. */ /*#define HAS_FPOS64_T / **/ +/* HAS_FREXPL: + * This symbol, if defined, indicates that the frexpl routine is + * available to break a long double floating-point number into + * a normalized fraction and an integral power of 2. + */ +#define HAS_FREXPL /**/ + /* HAS_STRUCT_FS_DATA: * This symbol, if defined, indicates that the struct fs_data * to do statfs() is supported. @@ -1392,6 +1370,12 @@ */ #define HAS_GETCWD /**/ +/* HAS_GETESPWNAM: + * This symbol, if defined, indicates that the getespwnam system call is + * available to retrieve enchanced (shadow) password entries by name. + */ +/*#define HAS_GETESPWNAM / **/ + /* HAS_GETFSSTAT: * This symbol, if defined, indicates that the getfsstat routine is * available to stat filesystems in bulk. @@ -1497,6 +1481,13 @@ */ #define HAS_GETNET_PROTOS /**/ +/* HAS_GETPAGESIZE: + * This symbol, if defined, indicates that the getpagesize system call + * is available to get system page size, which is the granularity of + * many memory management calls. + */ +#define HAS_GETPAGESIZE /**/ + /* HAS_GETPROTOENT: * This symbol, if defined, indicates that the getprotoent() routine is * available to look up protocols in some data base or another. @@ -1522,6 +1513,12 @@ */ #define HAS_GETPROTO_PROTOS /**/ +/* HAS_GETPRPWNAM: + * This symbol, if defined, indicates that the getprpwnam system call is + * available to retrieve protected (shadow) password entries by name. + */ +/*#define HAS_GETPRPWNAM / **/ + /* HAS_GETPWENT: * This symbol, if defined, indicates that the getpwent routine is * available for sequential access of the passwd database. @@ -1543,12 +1540,6 @@ */ #define HAS_GETSERV_PROTOS /**/ -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. - */ -/*#define HAS_GETSPENT / **/ - /* HAS_GETSPNAM: * This symbol, if defined, indicates that the getspnam system call is * available to retrieve SysV shadow password entries by name. @@ -1624,6 +1615,25 @@ */ #define HAS_ISASCII /**/ +/* HAS_ISNAN: + * This symbol, if defined, indicates that the isnan routine is + * available to check whether a double is a NaN. + */ +#define HAS_ISNAN /**/ + +/* HAS_ISNANL: + * This symbol, if defined, indicates that the isnanl routine is + * available to check whether a long double is a NaN. + */ +#define HAS_ISNANL /**/ + +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +#define HAS_LCHOWN /**/ + /* HAS_LDBL_DIG: * This symbol, if defined, indicates that this system's * or defines the symbol LDBL_DIG, which is the number @@ -1711,6 +1721,13 @@ #define HAS_MMAP /**/ #define Mmap_t void * /**/ +/* HAS_MODFL: + * This symbol, if defined, indicates that the modfl routine is + * available to split a long double x into a fractional part f and + * an integer part i such that |f| < 1.0 and (f + i) = x. + */ +#define HAS_MODFL /**/ + /* HAS_MPROTECT: * This symbol, if defined, indicates that the mprotect system call is * available to modify the access protection of a memory mapped file. @@ -1823,6 +1840,12 @@ */ #define HAS_SETPROTOENT /**/ +/* HAS_SETPROCTITLE: + * This symbol, if defined, indicates that the setproctitle routine is + * available to set process title. + */ +/*#define HAS_SETPROCTITLE / **/ + /* HAS_SETPWENT: * This symbol, if defined, indicates that the setpwent routine is * available for initializing sequential access of the passwd database. @@ -1835,12 +1858,6 @@ */ #define HAS_SETSERVENT /**/ -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. - */ -/*#define HAS_SETSPENT / **/ - /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -1944,6 +1961,12 @@ /*#define HAS_MSG_PROXY / **/ #define HAS_SCM_RIGHTS /**/ +/* HAS_SOCKS5_INIT: + * This symbol, if defined, indicates that the socks5_init routine is + * available to initialize SOCKS 5. + */ +/*#define HAS_SOCKS5_INIT / **/ + /* HAS_SQRTL: * This symbol, if defined, indicates that the sqrtl routine is * available to do long double square roots. @@ -2006,12 +2029,23 @@ * This symbol is defined if the FILE_cnt macro can be used as an * lvalue. */ +/* STDIO_PTR_LVAL_SETS_CNT: + * This symbol is defined if using the FILE_ptr macro as an lvalue + * to increase the pointer by n has the side effect of decreasing the + * value of File_cnt(fp) by n. + */ +/* STDIO_PTR_LVAL_NOCHANGE_CNT: + * This symbol is defined if using the FILE_ptr macro as an lvalue + * to increase the pointer by n leaves File_cnt(fp) unchanged. + */ #define USE_STDIO_PTR /**/ #ifdef USE_STDIO_PTR #define FILE_ptr(fp) ((fp)->_ptr) #define STDIO_PTR_LVALUE /**/ #define FILE_cnt(fp) ((fp)->_cnt) #define STDIO_CNT_LVALUE /**/ +/*#define STDIO_PTR_LVAL_SETS_CNT / **/ +#define STDIO_PTR_LVAL_NOCHANGE_CNT /**/ #endif /* USE_STDIO_BASE: @@ -2279,6 +2313,12 @@ */ /*#define I_INTTYPES / **/ +/* I_LIBUTIL: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_LIBUTIL / **/ + /* I_MACH_CTHREADS: * This symbol, if defined, indicates to the C program that it should * include . @@ -2309,6 +2349,12 @@ */ #define I_POLL /**/ +/* I_PROT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#define I_PROT /**/ + /* I_PTHREAD: * This symbol, if defined, indicates to the C program that it should * include . @@ -2471,8 +2517,18 @@ * This symbol, if defined, contains the string used by stdio to * format long doubles (format 'g') for output. */ +/* PERL_PRIeldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'e') for output. + */ +/* PERL_SCNfldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'f') for input. + */ #define PERL_PRIfldbl "f" /**/ #define PERL_PRIgldbl "g" /**/ +#define PERL_PRIeldbl "e" /**/ +#define PERL_SCNfldbl "f" /**/ /* Off_t: * This symbol holds the type used to declare offsets in the kernel. @@ -2560,6 +2616,16 @@ #define Netdb_name_t const char * /**/ #define Netdb_net_t int /**/ +/* PERL_OTHERLIBDIRS: + * This variable contains a colon-separated set of paths for the perl + * binary to search for additional library files or modules. + * These directories will be tacked to the end of @INC. + * Perl will automatically search below each path for version- + * and architecture-specific directories. See PERL_INC_VERSION_LIST + * for more details. + */ +/*#define PERL_OTHERLIBDIRS " " / **/ + /* IVTYPE: * This symbol defines the C type used for Perl's IV. */ @@ -2623,9 +2689,16 @@ /* U64SIZE: * This symbol contains the sizeof(U64). */ +/* NVSIZE: + * This symbol contains the sizeof(NV). + */ /* NV_PRESERVES_UV: * This symbol, if defined, indicates that a variable of type NVTYPE - * can preserve all the bit of a variable of type UVSIZE. + * can preserve all the bits of a variable of type UVTYPE. + */ +/* NV_PRESERVES_UV_BITS: + * This symbol contains the number of bits a variable of type NVTYPE + * can preserve of a variable of type UVTYPE. */ #define IVTYPE long /**/ #define UVTYPE unsigned long /**/ @@ -2652,7 +2725,9 @@ #define I64SIZE 8 /**/ #define U64SIZE 8 /**/ #endif +#define NVSIZE 8 /**/ #undef NV_PRESERVES_UV +#define NV_PRESERVES_UV_BITS 53 /* IVdf: * This symbol defines the format string used for printing a Perl IV @@ -2668,12 +2743,27 @@ */ /* UVxf: * This symbol defines the format string used for printing a Perl UV - * as an unsigned hexadecimal integer. + * as an unsigned hexadecimal integer in lowercase abcdef. + */ +/* NVef: + * This symbol defines the format string used for printing a Perl NV + * using %e-ish floating point format. + */ +/* NVff: + * This symbol defines the format string used for printing a Perl NV + * using %f-ish floating point format. + */ +/* NVgf: + * This symbol defines the format string used for printing a Perl NV + * using %g-ish floating point format. */ #define IVdf "ld" /**/ #define UVuf "lu" /**/ #define UVof "lo" /**/ #define UVxf "lx" /**/ +#define NVef "e" /**/ +#define NVff "f" /**/ +#define NVgf "g" /**/ /* Pid_t: * This symbol holds the type used to declare process ids in the kernel. @@ -2692,8 +2782,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "/opt/perl/lib/5.6.0" /**/ -#define PRIVLIB_EXP "/opt/perl/lib/5.6.0" /**/ +#define PRIVLIB "/opt/perl/lib/5.6.1" /**/ +#define PRIVLIB_EXP "/opt/perl/lib/5.6.1" /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -2791,8 +2881,8 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "/opt/perl/lib/site_perl/5.6.0/alpha-dec_osf-thread-multi" /**/ -#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.6.0/alpha-dec_osf-thread-multi" /**/ +#define SITEARCH "/opt/perl/lib/site_perl/5.6.1/alpha-dec_osf-thread" /**/ +#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.6.1/alpha-dec_osf-thread" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -2814,8 +2904,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "/opt/perl/lib/site_perl/5.6.0" /**/ -#define SITELIB_EXP "/opt/perl/lib/site_perl/5.6.0" /**/ +#define SITELIB "/opt/perl/lib/site_perl/5.6.1" /**/ +#define SITELIB_EXP "/opt/perl/lib/site_perl/5.6.1" /**/ #define SITELIB_STEM "/opt/perl/lib/site_perl" /**/ /* Size_t_size: @@ -2943,7 +3033,7 @@ * be built to use multiplicity. */ #ifndef MULTIPLICITY -#define MULTIPLICITY /**/ +/*#define MULTIPLICITY / **/ #endif /* USE_PERLIO: @@ -2975,8 +3065,8 @@ * This symbol, if defined, indicates that Perl should * be built to use the old draft POSIX threads API. */ -/*#define USE_5005THREADS / **/ -#define USE_ITHREADS /**/ +#define USE_5005THREADS /**/ +/*#define USE_ITHREADS / **/ #if defined(USE_5005THREADS) && !defined(USE_ITHREADS) #define USE_THREADS /* until src is revised*/ #endif @@ -3040,7 +3130,7 @@ /* PERL_XS_APIVERSION: * This variable contains the version of the oldest perl binary * compatible with the present perl. perl.c:incpush() and - * lib/lib.pm will automatically search in /opt/perl/lib/site_perl/5.6.0/alpha-dec_osf-thread-multi for older + * lib/lib.pm will automatically search in /opt/perl/lib/site_perl/5.6.1/alpha-dec_osf-thread for older * directories across major versions back to xs_apiversion. * This is only useful if you have a perl library directory tree * structured like the default one. @@ -3059,7 +3149,7 @@ * compatible with the present perl. (That is, pure perl modules * written for pm_apiversion will still work for the current * version). perl.c:incpush() and lib/lib.pm will automatically - * search in /opt/perl/lib/site_perl/5.6.0 for older directories across major versions + * search in /opt/perl/lib/site_perl/5.6.1 for older directories across major versions * back to pm_apiversion. This is only useful if you have a perl * library directory tree structured like the default one. The * versioned site_perl library was introduced in 5.005, so that's @@ -3069,20 +3159,65 @@ * (presumably) be similar. * See the INSTALL file for how this works. */ -#define PERL_XS_APIVERSION "5.6.0" +#define PERL_XS_APIVERSION "5.6.1" #define PERL_PM_APIVERSION "5.005" -/* HAS_LCHOWN: - * This symbol, if defined, indicates that the lchown routine is - * available to operate on a symbolic link (instead of following the - * link). +/* HAS_GETPGRP: + * This symbol, if defined, indicates that the getpgrp routine is + * available to get the current process group. */ -#define HAS_LCHOWN /**/ +/* USE_BSD_GETPGRP: + * This symbol, if defined, indicates that getpgrp needs one + * arguments whereas USG one needs none. + */ +#define HAS_GETPGRP /**/ +/*#define USE_BSD_GETPGRP / **/ -/* FLEXFILENAMES: - * This symbol, if defined, indicates that the system supports filenames - * longer than 14 characters. +/* HAS_SETPGRP: + * This symbol, if defined, indicates that the setpgrp routine is + * available to set the current process group. */ -#define FLEXFILENAMES /**/ +/* USE_BSD_SETPGRP: + * This symbol, if defined, indicates that setpgrp needs two + * arguments whereas USG one needs none. See also HAS_SETPGID + * for a POSIX interface. + */ +#define HAS_SETPGRP /**/ +#define USE_BSD_SETPGRP /**/ + +/* STDCHAR: + * This symbol is defined to be the type of char used in stdio.h. + * It has the values "unsigned char" or "char". + */ +#define STDCHAR unsigned char /**/ + +/* HAS__FWALK: + * This symbol, if defined, indicates that the _fwalk system call is + * available to apply a function to all the file handles. + */ +/*#define HAS__FWALK / **/ + +/* FCNTL_CAN_LOCK: + * This symbol, if defined, indicates that fcntl() can be used + * for file locking. Normally on Unix systems this is defined. + * It may be undefined on VMS. + */ +#define FCNTL_CAN_LOCK /**/ + +/* HAS_FSYNC: + * This symbol, if defined, indicates that the fsync routine is + * available to write a file's modified data and attributes to + * permanent storage. + */ +#define HAS_FSYNC /**/ + +/* HAS_SBRK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the sbrk() function. Otherwise, it is up + * to the program to supply one. Good guesses are + * extern void* sbrk _((int)); + * extern void* sbrk _((size_t)); + */ +#define HAS_SBRK_PROTO /**/ #endif diff --git a/contrib/perl5/Porting/genlog b/contrib/perl5/Porting/genlog index efb7ef8e108d..e040b9ef2cf4 100755 --- a/contrib/perl5/Porting/genlog +++ b/contrib/perl5/Porting/genlog @@ -20,7 +20,7 @@ use Text::Wrap; $0 =~ s|^.*/||; unless (@ARGV) { die < + $0 [-p \$P4PORT] [-bi branch_include] [-be branch_exclude] USAGE } @@ -32,6 +32,11 @@ my %editkind; my $p4port = $ENV{P4PORT} || 'localhost:1666'; +my @branch_include; +my @branch_exclude; +my %branch_include; +my %branch_exclude; + while (@ARGV) { $_ = shift; if (/^(\d+)\.\.(\d+)$/) { @@ -43,6 +48,12 @@ while (@ARGV) { elsif (/^-p(.*)$/) { $p4port = $1 || shift; } + elsif (/^-bi(.*)$/) { + push @branch_include, $1 || shift; + } + elsif (/^-be(.*)$/) { + push @branch_exclude, $1 || shift; + } else { warn "Arguments must be change numbers, ignoring `$_'\n"; } @@ -50,6 +61,9 @@ while (@ARGV) { @changes = sort { $b <=> $a } @changes; +@branch_include{@branch_include} = @branch_include if @branch_include; +@branch_exclude{@branch_exclude} = @branch_exclude if @branch_exclude; + my @desc = `p4 -p $p4port describe -s @changes`; if ($?) { die "$0: `p4 -p $p4port describe -s @changes` failed, status[$?]\n"; @@ -58,6 +72,8 @@ else { chomp @desc; while (@desc) { my ($change,$who,$date,$time,@log,$branch,$file,$type,%files); + my $skip = 0; + my $nbranch = 0; $_ = shift @desc; if (/^Change (\d+) by (\w+)\@.+ on (\S+) (\S+)\s*$/) { ($change, $who, $date, $time) = ($1,$2,$3,$4); @@ -73,6 +89,12 @@ else { last unless /^\.\.\./; if (m{^\.\.\. //depot/(.*?perl|[^/]*)/([^#]+)#\d+ (\w+)\s*$}) { ($branch,$file,$type) = ($1,$2,$3); + $nbranch++; + if (exists $branch_exclude{$branch} or + @branch_include and + not exists $branch_include{$branch}) { + $skip++; + } $files{$branch} = {} unless exists $files{$branch}; $files{$branch}{$type} = [] unless exists $files{$branch}{$type}; push @{$files{$branch}{$type}}, $file; @@ -83,7 +105,7 @@ else { } } } - next unless $change; + next if not $change or $skip == $nbranch; print "_" x 76, "\n"; printf < # -use vars qw($thisfile $change $file $fnum $h $v $p4port @addfiles); +use vars qw($thisfile $change $file $fnum $h $v $p4port @addfiles + $branches $skip); BEGIN { $0 =~ s|^.*/||; @@ -18,6 +19,9 @@ BEGIN { elsif (/^-p(.*)$/) { $p4port = $1 || ' '; } + elsif (/^-b(.*)$/) { + $branches = $1; + } elsif (/^-v$/) { $v++; } @@ -30,20 +34,28 @@ BEGIN { } unless (@files) { @files = '-'; undef $^I; } @ARGV = @files; + $branches = '//depot/perl/' unless defined $branches; if ($h) { print STDERR < change-123.desc @@ -65,14 +77,28 @@ my $cur = m|^Affected files| ... m|^Differences|; # while we are within range if ($cur) { - if (m{^\.\.\. (//depot/.+?#\d+) (add|branch)$}) { - my $newfile = $1; - push @addfiles, $newfile; - warn "$newfile add, revision != 1!\n" unless $newfile =~ /#1$/; + if (m|^\.\.\. |) { + if (m|$branches|) { + if (m{^\.\.\. (//depot/.+?\#\d+) (add|branch)$}) { + my $newfile = $1; + push @addfiles, $newfile; + warn "$newfile add, revision != 1!\n" unless $newfile =~ /#1$/; + } + } else { + push @skipped, "# $_"; + $_ = ''; + } } warn "file [$file] line [$cur] file# [$fnum]\n" if $v; } +if (m|^==== //depot/|) { + $skip = !m|$branches|; + print "# Skipped because not under branches: $branches\n" if $skip; +} + +$_ = "# $_" if $skip; + if (/^Change (\d+) by/) { $_ = "\n\n" . $_ if $change; # start of a new change list $change = $1; @@ -84,6 +110,9 @@ if (/^Change (\d+) by/) { if (eof) { $_ .= newfiles(); + $_ .= join('', "\n", + "# Skipped because not under branches: $branches\n", + @skipped, "\n") if @skipped; } sub newfiles { diff --git a/contrib/perl5/Porting/patching.pod b/contrib/perl5/Porting/patching.pod index 5659f23c60e1..7fd376b1a4d2 100644 --- a/contrib/perl5/Porting/patching.pod +++ b/contrib/perl5/Porting/patching.pod @@ -94,12 +94,7 @@ diffs. Some examples using GNU diff: # show function name in every hunk (safer, more informative) % diff -u -F '^[_a-zA-Z0-9]+ *(' old/file new/file - -=item Directories - -IMPORTANT: Patches should be generated from the source root directory, not -from the directory that the patched file resides in. This ensures that the -maintainer patches the proper file. +=item Derived Files Many files in the distribution are derivative--avoid patching them. Patch the originals instead. Most utilities (like perldoc) are in @@ -120,6 +115,31 @@ If you are submitting patches that affect multiple files then you should backup the entire directory tree (to $source_root.old/ for example). This will allow C to create all the patches at once. +=item Directories + +IMPORTANT: Patches should be generated from the source root directory, not +from the directory that the patched file resides in. This ensures that the +maintainer patches the proper file. + +For larger patches that are dealing with multiple files or +directories, Johan Vromans has written a powerful utility: makepatch. +See the JV directory on CPAN for the current version. If you have this +program available, it is recommended to create a duplicate of the perl +directory tree against which you are intending to provide a patch and +let makepatch figure out all the changes you made to your copy of the +sources. As perl comes with a MANIFEST file, you need not delete +object files and other derivative files from the two directory trees, +makepatch is smart about them. + +Say, you have created a directory perl-5.7.1@8685/ for the perl you +are taking as the base and a directory perl-5.7.1@8685-withfoo/ where +you have your changes, you would run makepatch as follows: + + makepatch -oldman perl-5.7.1@8685/MANIFEST \ + -newman perl-5.7.1@8685-withfoo/MANIFEST \ + -diff "diff -u" \ + perl-5.7.1@8685 perl-5.7.1@8685-withfoo + =item Try it yourself Just to make sure your patch "works", be sure to apply it to the Perl diff --git a/contrib/perl5/Porting/pumpkin.pod b/contrib/perl5/Porting/pumpkin.pod index 99776b50d2ee..3bc9d09c87ad 100644 --- a/contrib/perl5/Porting/pumpkin.pod +++ b/contrib/perl5/Porting/pumpkin.pod @@ -58,7 +58,7 @@ and 1 is the subversion. For compatibility with the older numbering scheme the composite floating point version number continues to be available as the magic variable $], -and amounts to C<$revision + $version/1000 + $subversion/1000000>. This +and amounts to C<$revision + $version/1000 + $subversion/100000>. This can still be used in comparisons. print "You've got an old perl\n" if $] < 5.005_03; @@ -210,7 +210,7 @@ unset appropriate Configure variables, based on the Configure command line options and possibly existing config.sh and Policy.sh files from previous Configure runs. -The extension hints are written Perl (by the time they are used +The extension hints are written in Perl (by the time they are used miniperl has been built) and control the building of their respective extensions. They can be used to for example manipulate compilation and linking flags. @@ -252,7 +252,8 @@ the first B to have a system call also update the list of A file called F at the top level that explains things like how to install perl at this platform, where to get any possibly required additional software, and for example what test suite errors -to expect, is nice too. +to expect, is nice too. Such files are in the process of being written +in pod format and will eventually be renamed F. You may also want to write a separate F<.pod> file for your operating system to tell about existing mailing lists, os-specific modules, @@ -449,7 +450,9 @@ safely be sorted, so it's easy to track (typically very small) changes to config.sh and then propoagate them to a canned 'config.h' by any number of means, including a perl script in win32/ or carrying config.sh and config_h.SH to a Unix system and running sh -config_h.SH.) +config_h.SH.) Vms uses configure.com to generate its own config.sh +and config.h. If you want to add a new variable to config.sh check +with vms folk how to add it to configure.com too. XXX] The Porting/config.sh and Porting/config_H files are provided to @@ -460,7 +463,7 @@ distinguish the file from config.h even on case-insensitive file systems.) Simply edit the existing config_H file; keep the first few explanatory lines and then copy your new config.h below. -It may also be necessary to update win32/config.?c, vms/config.vms and +It may also be necessary to update win32/config.?c, and plan9/config.plan9, though you should be quite careful in doing so if you are not familiar with those systems. You might want to issue your patch with a promise to quickly issue a follow-up that handles those @@ -481,8 +484,10 @@ output statements mean the patch won't apply cleanly. Long ago I started to fix F to detect this, but I never completed the task. -If C changes, make sure you run C to -update the corresponding VMS files. See L. +If C or C changes, make sure you run C +to update the corresponding VMS files. This could be taken care of by +the regen_all target in the Unix Makefile. See also +L. Some additional notes from Larry on this: @@ -507,6 +512,11 @@ could be automated, but it doesn't happen very often nowadays. Larry +=head2 make regen_all + +This target takes care of the PERLYVMS, regen_headers, and regen_pods +targets. + =head2 make regen_headers The F, F, and F files are all automatically @@ -532,6 +542,10 @@ and effort by manually running C myself rather than answering all the questions and complaints about the failing command. +=head2 make regen_pods + +Will run `make regen_pods` in the pod directory for indexing. + =head2 global.sym, interp.sym and perlio.sym Make sure these files are up-to-date. Read the comments in these @@ -541,7 +555,7 @@ files and in perl_exp.SH to see what to do. If you do change F or F, think carefully about what you are doing. To the extent reasonable, we'd like to maintain -souce and binary compatibility with older releases of perl. That way, +source and binary compatibility with older releases of perl. That way, extensions built under one version of perl will continue to work with new versions of perl. @@ -594,11 +608,11 @@ things that need to be fixed in Configure. =head2 VMS-specific updates If you have changed F or F, then you most probably want -to update F by running C. +to update F by running C, or +by running `make regen_all` which will run that script for you. -The Perl version number appears in several places under F. -It is courteous to update these versions. For example, if you are -making 5.004_42, replace "5.00441" with "5.00442". +The Perl revision number appears as "perl5" in configure.com. +It is courteous to update that if necessary. =head2 Making the new distribution @@ -701,6 +715,34 @@ supports dynamic loading, you can also test static loading with You can also hand-tweak your config.h to try out different #ifdef branches. +=head2 Other tests + +=over 4 + +=item CHECK_FORMAT + +To test the correct use of printf-style arguments, C with +S<-Dccflags='-DCHECK_FORMAT -Wformat'> and run C. The compiler +will produce warning of incorrect use of format arguments. CHECK_FORMAT +changes perl-defined formats to common formats, so DO NOT USE the executable +produced by this process. + +A more accurate approach is the following commands: + + sh Configure -des -Dccflags=-Wformat ... + make miniperl # without -DCHECK_FORMAT + perl -i.orig -pwe 's/-Wformat/-DCHECK_FORMAT $&/' config.sh + sh Configure -S + make >& make.log # build from correct miniperl + make clean + make miniperl >& mini.log # build miniperl with -DCHECK_FORMAT + perl -nwe 'print if /^\S+:/ and not /^make\b/' mini.log make.log + make clean + +(-Wformat support by Robin Barker.) + +=back + =head1 Running Purify Purify is a commercial tool that is helpful in identifying memory @@ -1325,7 +1367,8 @@ have good reason to do otherwise, I see no reason not to support them. =item File locking Somehow, straighten out, document, and implement lockf(), flock(), -and/or fcntl() file locking. It's a mess. +and/or fcntl() file locking. It's a mess. See $d_fcntl_can_lock +in recent config.sh files though. =back diff --git a/contrib/perl5/README b/contrib/perl5/README index 0925b98018cc..28c5de8b0387 100644 --- a/contrib/perl5/README +++ b/contrib/perl5/README @@ -1,7 +1,7 @@ Perl Kit, Version 5.0 - Copyright 1989-2000, Larry Wall + Copyright 1989-2001, Larry Wall All rights reserved. This program is free software; you can redistribute it and/or modify @@ -22,8 +22,10 @@ Kit, in the file named "Artistic". If not, I'll be glad to provide one. You should also have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software Foundation, - Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + along with this program in the file named "Copying". If not, write to the + Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA + 02111-1307, USA or visit their web page on the internet at + http://www.gnu.org/copyleft/gpl.html. For those of you that choose to use the GNU General Public License, my interpretation of the GNU General Public License is that no Perl @@ -70,7 +72,7 @@ corresponding README. 2) Read the manual entries before running perl. 3) IMPORTANT! Help save the world! Communicate any problems and suggested -patches to perlbug@perl.com so we can keep the world in sync. +patches to perlbug@perl.org so we can keep the world in sync. If you have a problem, there's someone else out there who either has had or will have the same problem. It's usually helpful if you send the output of the "myconfig" script in the main perl directory. diff --git a/contrib/perl5/README.Y2K b/contrib/perl5/README.Y2K index 378db15c11a0..be7ff51b68a4 100644 --- a/contrib/perl5/README.Y2K +++ b/contrib/perl5/README.Y2K @@ -21,7 +21,7 @@ Long answer: The question belies a true understanding of the localtime) supply adequate information to determine the year well beyond 2000 (2038 is when trouble strikes for 32-bit machines). The year returned by these functions - when used in an array context is the year minus 1900. For + when used in a list context is the year minus 1900. For years between 1910 and 1999 this happens to be a 2-digit decimal number. To avoid the year 2000 problem simply do not treat the year as a 2-digit number. It isn't. diff --git a/contrib/perl5/Todo b/contrib/perl5/Todo index ba01d33db6f2..eb13f6588e5a 100644 --- a/contrib/perl5/Todo +++ b/contrib/perl5/Todo @@ -47,10 +47,6 @@ Would be nice to have to be used in re-entrant (=multithreaded) code Icky things: the _r API is not standardized and the _r-forms require per-thread data to store their state - memory profiler: turn malloc.c:Perl_get_mstats() into - an extension (Devel::MProf?) that would return the malloc - stats in a nice Perl datastructure (also a simple interface - to return just the grand total would be good) cross-compilation support host vs target: compile in the host, get the executable to the target, get the possible input files to the target, diff --git a/contrib/perl5/Todo-5.6 b/contrib/perl5/Todo-5.6 index 9abeb55ebb7a..71aca9cb0163 100644 --- a/contrib/perl5/Todo-5.6 +++ b/contrib/perl5/Todo-5.6 @@ -1,6 +1,5 @@ Unicode support finish byte <-> utf8 and localencoding <-> utf8 conversions - make substr($bytestr,0,0,$charstr) do the right conversion add Unicode::Map equivivalent to core add support for I/O disciplines - a way to specify disciplines when opening things: @@ -12,7 +11,25 @@ Unicode support eliminate need for "use utf8;" autoload byte.pm when byte:: is seen by the parser check uv_to_utf8() calls for buffer overflow - (see also "Locales", "Regexen", and "Miscellaneous") + make \uXXXX (and \u{XXXX}?) where XXXX are hex digits + to work similarly to Unicode tech reports and Java + notation \uXXXX (and already existing \x{XXXX))? + more than four hexdigits? make also \U+XXXX work? + overloadable regex assertions? e.g. in Thai \b cannot + be deduced by any simple character class boundary rules, + word boundaries must algorithmically computed + + see ext/Encode/Todo for notes and references about proper detection + of malformed UTF-8 + + SCSU? http://www.unicode.org/unicode/reports/tr6/ + Collation? http://www.unicode.org/unicode/reports/tr10/ + Normalization? http://www.unicode.org/unicode/reports/tr15/ + EBCDIC? http://www.unicode.org/unicode/reports/tr16/ + Regexes? http://www.unicode.org/unicode/reports/tr18/ + Case Mappings? http://www.unicode.org/unicode/reports/tr21/ + + See also "Locales", "Regexen", and "Miscellaneous". Multi-threading support "use Thread;" under useithreads @@ -39,17 +56,18 @@ Namespace cleanup API-space: complete the list of things that constitute public api Configure - fix the vicious cyclic multidependency of cc <-> libpth <-> loclibpth - libswanted <-> usethreads <-> use64bitint <-> use64bitall <-> - uselargefiles <-> ... make configuring+building away from source directory work (VPATH et al) this is related to: cross-compilation configuring (see Todo) _r support (see Todo for mode detailed description) POSIX 1003.1 1996 Edition support--realtime stuff: POSIX semaphores, message queues, shared memory, realtime clocks, timers, signals (the metaconfig units mostly already exist for these) + PREFERABLY AS AN EXTENSION UNIX98 support: reader-writer locks, realtime/asynchronous IO + PREFERABLY AS AN EXTENSION IPv6 support: see RFC2292, RFC2553 + PREFERABLY AS AN EXTENSION + there already is Socket6 in CPAN Long doubles figure out where the PV->NV->PV conversion gets it wrong at least @@ -60,6 +78,7 @@ Long doubles 64-bit support Configure probe for quad_t, uquad_t, and (argh) u_quad_t, they might be in some systems the only thing working as quadtype and uquadtype. + more pain: long_long, u_long_long. Locales deprecate traditional/legacy locales? @@ -67,15 +86,16 @@ Locales figure out how to support Unicode locales suggestion: integrate the IBM Classes for Unicode (ICU) http://oss.software.ibm.com/developerworks/opensource/icu/project/ - and check out also the Locale Converter: + ICU is "portable, open-source Unicode library with: + charset-independent locales (with multiple locales + simultaneously supported in same thread; character + conversions; formatting/parsing for numbers, currencies, + date/time and messages; message catalogs (resources); + transliteration, collation, normalization, and text + boundaries (grapheme, word, line-break))". + Check out also the Locale Converter: http://alphaworks.ibm.com/tech/localeconverter - ICU is "portable, open-source Unicode library with: - charset-independent locales (with multiple locales simultaneously - supported in same thread; character conversions; formatting/parsing - for numbers, currencies, date/time and messages; message catalogs - (resources) ; transliteration, collation, normalization, and text - boundaries (grapheme, word, line-break))". - There is also 'iconv', either from XPG4 or GNU (glibc). + There is also the iconv interface, either from XPG4 or GNU (glibc). iconv is about character set conversions. Either ICU or iconv would be valuable to get integrated into Perl, Configure already probes for libiconv and . @@ -101,6 +121,9 @@ Regexen this is also a part of the Unicode 3.0: http://www.unicode.org/unicode/uni2book/u2.html executive summary: there are several different levels of 'equivalence' + trie optimization: factor out common suffixes (and prefixes?) + from |-alternating groups (both for exact strings and character + classes, use lookaheads?) approximate matching Security @@ -120,22 +143,27 @@ Win32 stuff work out DLL versioning Miscellaneous + introduce @( and @) because group names can have spaces add new modules (Archive::Tar, Compress::Zlib, CPAN::FTP?) sub-second sleep()? alarm()? time()? (integrate Time::HiRes? Configure doesn't yet probe for usleep/nanosleep/ualarm but the units exist) floating point handling: nans, infinities, fp exception masks, etc. - at least the following interfaces exist: fp_classify(), fp_class(), - class(), isnan(), isinf(), isfinite(), finite(), isnormal(), - ordered(), fp_setmask(), fp_getmask(), fp_setround(), fp_getround(), - ieeefp.h, fp_class.h. There are metaconfig units for most of these. - Search for ifdef __osf__ in pp.c to find a temporary fix that - needs to be done right. + At least the following interfaces exist: fp_classify(), fp_class(), + class(), isinf(), isfinite(), finite(), isnormal(), unordered(), + , (there are metaconfig units for all these), + fp_setmask(), fp_getmask(), fp_setround(), fp_getround() + (no metaconfig units yet for these). + Don't forget finitel(), fp_classl(), fp_class_l(), (yes, both do, + unfortunately, exist), and unorderedl(). + PREFERABLY AS AN EXTENSION. + As of 5.6.1 there is cpp macro Perl_isnan(). fix the basic arithmetics (+ - * / %) to preserve IVness/UVness if - both arguments are IVs/UVs + both arguments are IVs/UVs: it sucks that one cannot see + the 'carry flag' (or equivalent) of the CPU from C, + C is too high-level... replace pod2html with new PodtoHtml? (requires other modules from CPAN) automate testing with large parts of CPAN - Unicode collation? http://www.unicode.org/unicode/reports/tr10/ turn Cwd into an XS module? (Configure already probes for getcwd()) mmap for speeding up input? (Configure already probes for the mmap family) sendmsg, recvmsg? (Configure doesn't probe for these but the units exist) @@ -154,3 +182,5 @@ Documentation spot-check all new modules for completeness better docs for pack()/unpack() reorg tutorials vs. reference sections + make roffitall to be dynamical about its pods and libs + diff --git a/contrib/perl5/av.c b/contrib/perl5/av.c index 819887e2ad59..273fed94eb54 100644 --- a/contrib/perl5/av.c +++ b/contrib/perl5/av.c @@ -1,6 +1,6 @@ /* av.c * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -34,10 +34,8 @@ Perl_av_reify(pTHX_ AV *av) while (key) { sv = AvARRAY(av)[--key]; assert(sv); - if (sv != &PL_sv_undef) { - dTHR; + if (sv != &PL_sv_undef) (void)SvREFCNT_inc(sv); - } } key = AvARRAY(av) - AvALLOC(av); while (key) @@ -58,7 +56,6 @@ extended. void Perl_av_extend(pTHX_ AV *av, I32 key) { - dTHR; /* only necessary if we have to extend stack */ MAGIC *mg; if ((mg = SvTIED_mg((SV*)av, 'P'))) { dSP; @@ -189,7 +186,6 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval) if (SvRMAGICAL(av)) { if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) { - dTHR; sv = sv_newmortal(); mg_copy((SV*)av, sv, 0, key); PL_av_fetch_sv = sv; @@ -272,7 +268,6 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val) ary = AvARRAY(av); if (AvFILLp(av) < key) { if (!AvREAL(av)) { - dTHR; if (av == PL_curstack && key > PL_stack_sp - PL_stack_base) PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */ do @@ -554,6 +549,7 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num) register I32 i; register SV **ary; MAGIC* mg; + I32 slide; if (!av || num <= 0) return; @@ -591,6 +587,9 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num) } if (num) { i = AvFILLp(av); + /* Create extra elements */ + slide = i > 0 ? i : 0; + num += slide; av_extend(av, i + num); AvFILLp(av) += num; ary = AvARRAY(av); @@ -598,6 +597,10 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num) do { ary[--num] = &PL_sv_undef; } while (num); + /* Make extra elements into a buffer */ + AvMAX(av) -= slide; + AvFILLp(av) -= slide; + SvPVX(av) = (char*)(AvARRAY(av) + slide); } } @@ -661,6 +664,14 @@ Perl_av_len(pTHX_ register AV *av) return AvFILL(av); } +/* +=for apidoc av_fill + +Ensure than an array has a given number of elements, equivalent to +Perl's C<$#array = $fill;>. + +=cut +*/ void Perl_av_fill(pTHX_ register AV *av, I32 fill) { @@ -708,6 +719,14 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill) (void)av_store(av,fill,&PL_sv_undef); } +/* +=for apidoc av_delete + +Deletes the element indexed by C from the array. Returns the +deleted element. C is currently ignored. + +=cut +*/ SV * Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags) { @@ -758,10 +777,15 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags) } /* - * This relies on the fact that uninitialized array elements - * are set to &PL_sv_undef. - */ +=for apidoc av_exists +Returns true if the element indexed by C has been initialized. + +This relies on the fact that uninitialized array elements are set to +C<&PL_sv_undef>. + +=cut +*/ bool Perl_av_exists(pTHX_ AV *av, I32 key) { @@ -775,9 +799,14 @@ Perl_av_exists(pTHX_ AV *av, I32 key) if (SvRMAGICAL(av)) { if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) { SV *sv = sv_newmortal(); + MAGIC *mg; + mg_copy((SV*)av, sv, 0, key); - magic_existspack(sv, mg_find(sv, 'p')); - return SvTRUE(sv); + mg = mg_find(sv, 'p'); + if (mg) { + magic_existspack(sv, mg); + return SvTRUE(sv); + } } } if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef diff --git a/contrib/perl5/av.h b/contrib/perl5/av.h index 6b66bfd1b1de..8f130d63c007 100644 --- a/contrib/perl5/av.h +++ b/contrib/perl5/av.h @@ -1,6 +1,6 @@ /* av.h * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -32,8 +32,8 @@ struct xpvav { * real if the array needs to be modified in some way. Functions that * modify fake AVs check both flags to call av_reify() as appropriate. * - * Note that the Perl stack has neither flag set. (Thus, items that go - * on the stack are never refcounted.) + * Note that the Perl stack and @DB::args have neither flag set. (Thus, + * items that go on the stack are never refcounted.) * * These internal details are subject to change any time. AV * manipulations external to perl should not care about any of this. diff --git a/contrib/perl5/bytecode.pl b/contrib/perl5/bytecode.pl index d1e1c708c0dc..4b00e14b9a11 100644 --- a/contrib/perl5/bytecode.pl +++ b/contrib/perl5/bytecode.pl @@ -13,7 +13,7 @@ my @optype= qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP); # Nullsv *must* come first in the following so that the condition # ($$sv == 0) can continue to be used to test (sv == Nullsv). -my @specialsv = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no); +my @specialsv = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no pWARN_ALL pWARN_NONE); my (%alias_from, $from, $tos); while (($from, $tos) = each %alias_to) { @@ -82,7 +82,7 @@ print BYTERUN_C $c_header, <<'EOT'; #include "bytecode.h" -static int optype_size[] = { +static const int optype_size[] = { EOT my $i = 0; for ($i = 0; $i < @optype - 1; $i++) { @@ -92,33 +92,27 @@ printf BYTERUN_C " sizeof(%s)\n", $optype[$i], $i; print BYTERUN_C <<'EOT'; }; -static SV *specialsv_list[4]; - -static int bytecode_iv_overflows = 0; -static SV *bytecode_sv; -static XPV bytecode_pv; -static void **bytecode_obj_list; -static I32 bytecode_obj_list_fill = -1; - void * -bset_obj_store(pTHXo_ void *obj, I32 ix) +bset_obj_store(pTHXo_ struct byteloader_state *bstate, void *obj, I32 ix) { - if (ix > bytecode_obj_list_fill) { - if (bytecode_obj_list_fill == -1) - New(666, bytecode_obj_list, ix + 1, void*); - else - Renew(bytecode_obj_list, ix + 1, void*); - bytecode_obj_list_fill = ix; + if (ix > bstate->bs_obj_list_fill) { + Renew(bstate->bs_obj_list, ix + 32, void*); + bstate->bs_obj_list_fill = ix + 31; } - bytecode_obj_list[ix] = obj; + bstate->bs_obj_list[ix] = obj; return obj; } void -byterun(pTHXo_ struct bytestream bs) +byterun(pTHXo_ register struct byteloader_state *bstate) { - dTHR; - int insn; + register int insn; + U32 ix; + SV *specialsv_list[6]; + + BYTECODE_HEADER_CHECK; /* croak if incorrect platform */ + New(666, bstate->bs_obj_list, 32, void*); /* set op objlist */ + bstate->bs_obj_list_fill = 31; EOT @@ -198,13 +192,25 @@ EOT # open(BYTERUN_H, ">ext/ByteLoader/byterun.h") or die "ext/ByteLoader/byterun.h: $!"; print BYTERUN_H $c_header, <<'EOT'; -struct bytestream { - void *data; - int (*pfgetc)(void *); - int (*pfread)(char *, size_t, size_t, void *); - void (*pfreadpv)(U32, void *, XPV *); +struct byteloader_fdata { + SV *datasv; + int next_out; + int idx; }; +struct byteloader_state { + struct byteloader_fdata *bs_fdata; + SV *bs_sv; + void **bs_obj_list; + int bs_obj_list_fill; + XPV bs_pv; + int bs_iv_overflows; +}; + +int bl_getc(struct byteloader_fdata *); +int bl_read(struct byteloader_fdata *, char *, size_t, size_t); +extern void byterun(pTHXo_ struct byteloader_state *); + enum { EOT @@ -233,18 +239,6 @@ for ($i = 0; $i < @optype - 1; $i++) { } printf BYTERUN_H " OPt_%s\t\t/* %d */\n};\n\n", $optype[$i], $i; -print BYTERUN_H <<'EOT'; -extern void byterun(pTHXo_ struct bytestream bs); - -#define INIT_SPECIALSV_LIST STMT_START { \ -EOT -for ($i = 0; $i < @specialsv; $i++) { - print BYTERUN_H "\tPL_specialsv_list[$i] = $specialsv[$i]; \\\n"; -} -print BYTERUN_H <<'EOT'; - } STMT_END -EOT - # # Finish off insn_data and create array initialisers in Asmdata.pm # @@ -294,85 +288,86 @@ nop none none #opcode lvalue argtype flags # ret none none x -ldsv bytecode_sv svindex +ldsv bstate->bs_sv svindex ldop PL_op opindex -stsv bytecode_sv U32 s +stsv bstate->bs_sv U32 s stop PL_op U32 s -ldspecsv bytecode_sv U8 x -newsv bytecode_sv U8 x +stpv bstate->bs_pv.xpv_pv U32 x +ldspecsv bstate->bs_sv U8 x +newsv bstate->bs_sv U8 x newop PL_op U8 x newopn PL_op U8 x newpv none PV -pv_cur bytecode_pv.xpv_cur STRLEN -pv_free bytecode_pv none x -sv_upgrade bytecode_sv char x -sv_refcnt SvREFCNT(bytecode_sv) U32 -sv_refcnt_add SvREFCNT(bytecode_sv) I32 x -sv_flags SvFLAGS(bytecode_sv) U32 -xrv SvRV(bytecode_sv) svindex -xpv bytecode_sv none x -xiv32 SvIVX(bytecode_sv) I32 -xiv64 SvIVX(bytecode_sv) IV64 -xnv SvNVX(bytecode_sv) NV -xlv_targoff LvTARGOFF(bytecode_sv) STRLEN -xlv_targlen LvTARGLEN(bytecode_sv) STRLEN -xlv_targ LvTARG(bytecode_sv) svindex -xlv_type LvTYPE(bytecode_sv) char -xbm_useful BmUSEFUL(bytecode_sv) I32 -xbm_previous BmPREVIOUS(bytecode_sv) U16 -xbm_rare BmRARE(bytecode_sv) U8 -xfm_lines FmLINES(bytecode_sv) I32 -xio_lines IoLINES(bytecode_sv) long -xio_page IoPAGE(bytecode_sv) long -xio_page_len IoPAGE_LEN(bytecode_sv) long -xio_lines_left IoLINES_LEFT(bytecode_sv) long -xio_top_name IoTOP_NAME(bytecode_sv) pvcontents -xio_top_gv *(SV**)&IoTOP_GV(bytecode_sv) svindex -xio_fmt_name IoFMT_NAME(bytecode_sv) pvcontents -xio_fmt_gv *(SV**)&IoFMT_GV(bytecode_sv) svindex -xio_bottom_name IoBOTTOM_NAME(bytecode_sv) pvcontents -xio_bottom_gv *(SV**)&IoBOTTOM_GV(bytecode_sv) svindex -xio_subprocess IoSUBPROCESS(bytecode_sv) short -xio_type IoTYPE(bytecode_sv) char -xio_flags IoFLAGS(bytecode_sv) char -xcv_stash *(SV**)&CvSTASH(bytecode_sv) svindex -xcv_start CvSTART(bytecode_sv) opindex -xcv_root CvROOT(bytecode_sv) opindex -xcv_gv *(SV**)&CvGV(bytecode_sv) svindex -xcv_file CvFILE(bytecode_sv) pvcontents -xcv_depth CvDEPTH(bytecode_sv) long -xcv_padlist *(SV**)&CvPADLIST(bytecode_sv) svindex -xcv_outside *(SV**)&CvOUTSIDE(bytecode_sv) svindex -xcv_flags CvFLAGS(bytecode_sv) U16 -av_extend bytecode_sv SSize_t x -av_push bytecode_sv svindex x -xav_fill AvFILLp(bytecode_sv) SSize_t -xav_max AvMAX(bytecode_sv) SSize_t -xav_flags AvFLAGS(bytecode_sv) U8 -xhv_riter HvRITER(bytecode_sv) I32 -xhv_name HvNAME(bytecode_sv) pvcontents -hv_store bytecode_sv svindex x -sv_magic bytecode_sv char x -mg_obj SvMAGIC(bytecode_sv)->mg_obj svindex -mg_private SvMAGIC(bytecode_sv)->mg_private U16 -mg_flags SvMAGIC(bytecode_sv)->mg_flags U8 -mg_pv SvMAGIC(bytecode_sv) pvcontents x -xmg_stash *(SV**)&SvSTASH(bytecode_sv) svindex -gv_fetchpv bytecode_sv strconst x -gv_stashpv bytecode_sv strconst x -gp_sv GvSV(bytecode_sv) svindex -gp_refcnt GvREFCNT(bytecode_sv) U32 -gp_refcnt_add GvREFCNT(bytecode_sv) I32 x -gp_av *(SV**)&GvAV(bytecode_sv) svindex -gp_hv *(SV**)&GvHV(bytecode_sv) svindex -gp_cv *(SV**)&GvCV(bytecode_sv) svindex -gp_file GvFILE(bytecode_sv) pvcontents -gp_io *(SV**)&GvIOp(bytecode_sv) svindex -gp_form *(SV**)&GvFORM(bytecode_sv) svindex -gp_cvgen GvCVGEN(bytecode_sv) U32 -gp_line GvLINE(bytecode_sv) line_t -gp_share bytecode_sv svindex x -xgv_flags GvFLAGS(bytecode_sv) U8 +pv_cur bstate->bs_pv.xpv_cur STRLEN +pv_free bstate->bs_pv none x +sv_upgrade bstate->bs_sv char x +sv_refcnt SvREFCNT(bstate->bs_sv) U32 +sv_refcnt_add SvREFCNT(bstate->bs_sv) I32 x +sv_flags SvFLAGS(bstate->bs_sv) U32 +xrv SvRV(bstate->bs_sv) svindex +xpv bstate->bs_sv none x +xiv32 SvIVX(bstate->bs_sv) I32 +xiv64 SvIVX(bstate->bs_sv) IV64 +xnv SvNVX(bstate->bs_sv) NV +xlv_targoff LvTARGOFF(bstate->bs_sv) STRLEN +xlv_targlen LvTARGLEN(bstate->bs_sv) STRLEN +xlv_targ LvTARG(bstate->bs_sv) svindex +xlv_type LvTYPE(bstate->bs_sv) char +xbm_useful BmUSEFUL(bstate->bs_sv) I32 +xbm_previous BmPREVIOUS(bstate->bs_sv) U16 +xbm_rare BmRARE(bstate->bs_sv) U8 +xfm_lines FmLINES(bstate->bs_sv) I32 +xio_lines IoLINES(bstate->bs_sv) long +xio_page IoPAGE(bstate->bs_sv) long +xio_page_len IoPAGE_LEN(bstate->bs_sv) long +xio_lines_left IoLINES_LEFT(bstate->bs_sv) long +xio_top_name IoTOP_NAME(bstate->bs_sv) pvcontents +xio_top_gv *(SV**)&IoTOP_GV(bstate->bs_sv) svindex +xio_fmt_name IoFMT_NAME(bstate->bs_sv) pvcontents +xio_fmt_gv *(SV**)&IoFMT_GV(bstate->bs_sv) svindex +xio_bottom_name IoBOTTOM_NAME(bstate->bs_sv) pvcontents +xio_bottom_gv *(SV**)&IoBOTTOM_GV(bstate->bs_sv) svindex +xio_subprocess IoSUBPROCESS(bstate->bs_sv) short +xio_type IoTYPE(bstate->bs_sv) char +xio_flags IoFLAGS(bstate->bs_sv) char +xcv_stash *(SV**)&CvSTASH(bstate->bs_sv) svindex +xcv_start CvSTART(bstate->bs_sv) opindex +xcv_root CvROOT(bstate->bs_sv) opindex +xcv_gv *(SV**)&CvGV(bstate->bs_sv) svindex +xcv_file CvFILE(bstate->bs_sv) pvindex +xcv_depth CvDEPTH(bstate->bs_sv) long +xcv_padlist *(SV**)&CvPADLIST(bstate->bs_sv) svindex +xcv_outside *(SV**)&CvOUTSIDE(bstate->bs_sv) svindex +xcv_flags CvFLAGS(bstate->bs_sv) U16 +av_extend bstate->bs_sv SSize_t x +av_push bstate->bs_sv svindex x +xav_fill AvFILLp(bstate->bs_sv) SSize_t +xav_max AvMAX(bstate->bs_sv) SSize_t +xav_flags AvFLAGS(bstate->bs_sv) U8 +xhv_riter HvRITER(bstate->bs_sv) I32 +xhv_name HvNAME(bstate->bs_sv) pvcontents +hv_store bstate->bs_sv svindex x +sv_magic bstate->bs_sv char x +mg_obj SvMAGIC(bstate->bs_sv)->mg_obj svindex +mg_private SvMAGIC(bstate->bs_sv)->mg_private U16 +mg_flags SvMAGIC(bstate->bs_sv)->mg_flags U8 +mg_pv SvMAGIC(bstate->bs_sv) pvcontents x +xmg_stash *(SV**)&SvSTASH(bstate->bs_sv) svindex +gv_fetchpv bstate->bs_sv strconst x +gv_stashpv bstate->bs_sv strconst x +gp_sv GvSV(bstate->bs_sv) svindex +gp_refcnt GvREFCNT(bstate->bs_sv) U32 +gp_refcnt_add GvREFCNT(bstate->bs_sv) I32 x +gp_av *(SV**)&GvAV(bstate->bs_sv) svindex +gp_hv *(SV**)&GvHV(bstate->bs_sv) svindex +gp_cv *(SV**)&GvCV(bstate->bs_sv) svindex +gp_file GvFILE(bstate->bs_sv) pvindex +gp_io *(SV**)&GvIOp(bstate->bs_sv) svindex +gp_form *(SV**)&GvFORM(bstate->bs_sv) svindex +gp_cvgen GvCVGEN(bstate->bs_sv) U32 +gp_line GvLINE(bstate->bs_sv) line_t +gp_share bstate->bs_sv svindex x +xgv_flags GvFLAGS(bstate->bs_sv) U8 op_next PL_op->op_next opindex op_sibling PL_op->op_sibling opindex op_ppaddr PL_op->op_ppaddr strconst x @@ -384,7 +379,6 @@ op_private PL_op->op_private U8 op_first cUNOP->op_first opindex op_last cBINOP->op_last opindex op_other cLOGOP->op_other opindex -op_children cLISTOP->op_children U32 op_pmreplroot cPMOP->op_pmreplroot opindex op_pmreplrootgv *(SV**)&cPMOP->op_pmreplroot svindex op_pmreplstart cPMOP->op_pmreplstart opindex @@ -399,9 +393,9 @@ op_pv_tr cPVOP->op_pv op_tr_array op_redoop cLOOP->op_redoop opindex op_nextop cLOOP->op_nextop opindex op_lastop cLOOP->op_lastop opindex -cop_label cCOP->cop_label pvcontents -cop_stashpv cCOP pvcontents x -cop_file cCOP pvcontents x +cop_label cCOP->cop_label pvindex +cop_stashpv cCOP pvindex x +cop_file cCOP pvindex x cop_seq cCOP->cop_seq U32 cop_arybase cCOP->cop_arybase I32 cop_line cCOP line_t x @@ -409,3 +403,6 @@ cop_warnings cCOP->cop_warnings svindex main_start PL_main_start opindex main_root PL_main_root opindex curpad PL_curpad svindex x +push_begin PL_beginav svindex x +push_init PL_initav svindex x +push_end PL_endav svindex x diff --git a/contrib/perl5/cflags.SH b/contrib/perl5/cflags.SH index ec6dc3570e48..d2152557375f 100755 --- a/contrib/perl5/cflags.SH +++ b/contrib/perl5/cflags.SH @@ -129,8 +129,8 @@ for file do fi : Can we perhaps use $ansi2knr here - echo "$cc -c -DPERL_CORE $ccflags $optimize $perltype $large $split" - eval "$also "'"$cc -DPERL_CORE -c $ccflags $optimize $perltype $large $split"' + echo "$cc -c -DPERL_CORE $ccflags $optimize $perltype" + eval "$also "'"$cc -DPERL_CORE -c $ccflags $optimize $perltype"' . $TOP/config.sh diff --git a/contrib/perl5/config_h.SH b/contrib/perl5/config_h.SH index 70f220ec91e7..ae7f337a62a7 100755 --- a/contrib/perl5/config_h.SH +++ b/contrib/perl5/config_h.SH @@ -238,17 +238,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getpgid HAS_GETPGID /**/ -/* HAS_GETPGRP: - * This symbol, if defined, indicates that the getpgrp routine is - * available to get the current process group. - */ -/* USE_BSD_GETPGRP: - * This symbol, if defined, indicates that getpgrp needs one - * arguments whereas USG one needs none. - */ -#$d_getpgrp HAS_GETPGRP /**/ -#$d_bsdgetpgrp USE_BSD_GETPGRP /**/ - /* HAS_GETPGRP2: * This symbol, if defined, indicates that the getpgrp2() (as in DG/UX) * routine is available to get the current process group. @@ -503,18 +492,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_setpgid HAS_SETPGID /**/ -/* HAS_SETPGRP: - * This symbol, if defined, indicates that the setpgrp routine is - * available to set the current process group. - */ -/* USE_BSD_SETPGRP: - * This symbol, if defined, indicates that setpgrp needs two - * arguments whereas USG one needs none. See also HAS_SETPGID - * for a POSIX interface. - */ -#$d_setpgrp HAS_SETPGRP /**/ -#$d_bsdsetpgrp USE_BSD_SETPGRP /**/ - /* HAS_SETPGRP2: * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX) * routine is available to set the current process group. @@ -998,12 +975,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define SH_PATH "$sh" /**/ -/* STDCHAR: - * This symbol is defined to be the type of char used in stdio.h. - * It has the values "unsigned char" or "char". - */ -#define STDCHAR $stdchar /**/ - /* CROSSCOMPILE: * This symbol, if defined, signifies that we our * build process is a cross-compilation. @@ -1198,21 +1169,21 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * This macro surrounds its token with double quotes. */ #if $cpp_stuff == 1 -# define CAT2(a,b) a/**/b -# define STRINGIFY(a) "a" +#define CAT2(a,b) a/**/b +#define STRINGIFY(a) "a" /* If you can get stringification with catify, tell me how! */ #endif #if $cpp_stuff == 42 -# define PeRl_CaTiFy(a, b) a ## b -# define PeRl_StGiFy(a) #a +#define PeRl_CaTiFy(a, b) a ## b +#define PeRl_StGiFy(a) #a /* the additional level of indirection enables these macros to be * used as arguments to other macros. See K&R 2nd ed., page 231. */ -# define CAT2(a,b) PeRl_CaTiFy(a,b) -# define StGiFy(a) PeRl_StGiFy(a) -# define STRINGIFY(a) PeRl_StGiFy(a) +#define CAT2(a,b) PeRl_CaTiFy(a,b) +#define StGiFy(a) PeRl_StGiFy(a) +#define STRINGIFY(a) PeRl_StGiFy(a) #endif #if $cpp_stuff != 1 && $cpp_stuff != 42 -#include "Bletch: How does this C preprocessor catenate tokens?" +# include "Bletch: How does this C preprocessor catenate tokens?" #endif /* CPPSTDIN: @@ -1342,23 +1313,30 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_endsent HAS_ENDSERVENT /**/ -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. - */ -#$d_endspent HAS_ENDSPENT /**/ - /* HAS_FD_SET: * This symbol, when defined, indicates presence of the fd_set typedef * in */ #$d_fd_set HAS_FD_SET /**/ +/* FLEXFILENAMES: + * This symbol, if defined, indicates that the system supports filenames + * longer than 14 characters. + */ +#$d_flexfnam FLEXFILENAMES /**/ + /* HAS_FPOS64_T: * This symbol will be defined if the C compiler supports fpos64_t. */ #$d_fpos64_t HAS_FPOS64_T /**/ +/* HAS_FREXPL: + * This symbol, if defined, indicates that the frexpl routine is + * available to break a long double floating-point number into + * a normalized fraction and an integral power of 2. + */ +#$d_frexpl HAS_FREXPL /**/ + /* HAS_STRUCT_FS_DATA: * This symbol, if defined, indicates that the struct fs_data * to do statfs() is supported. @@ -1406,6 +1384,12 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getcwd HAS_GETCWD /**/ +/* HAS_GETESPWNAM: + * This symbol, if defined, indicates that the getespwnam system call is + * available to retrieve enchanced (shadow) password entries by name. + */ +#$d_getespwnam HAS_GETESPWNAM /**/ + /* HAS_GETFSSTAT: * This symbol, if defined, indicates that the getfsstat routine is * available to stat filesystems in bulk. @@ -1511,6 +1495,13 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getnetprotos HAS_GETNET_PROTOS /**/ +/* HAS_GETPAGESIZE: + * This symbol, if defined, indicates that the getpagesize system call + * is available to get system page size, which is the granularity of + * many memory management calls. + */ +#$d_getpagsz HAS_GETPAGESIZE /**/ + /* HAS_GETPROTOENT: * This symbol, if defined, indicates that the getprotoent() routine is * available to look up protocols in some data base or another. @@ -1536,6 +1527,12 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getprotoprotos HAS_GETPROTO_PROTOS /**/ +/* HAS_GETPRPWNAM: + * This symbol, if defined, indicates that the getprpwnam system call is + * available to retrieve protected (shadow) password entries by name. + */ +#$d_getprpwnam HAS_GETPRPWNAM /**/ + /* HAS_GETPWENT: * This symbol, if defined, indicates that the getpwent routine is * available for sequential access of the passwd database. @@ -1557,12 +1554,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getservprotos HAS_GETSERV_PROTOS /**/ -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. - */ -#$d_getspent HAS_GETSPENT /**/ - /* HAS_GETSPNAM: * This symbol, if defined, indicates that the getspnam system call is * available to retrieve SysV shadow password entries by name. @@ -1638,6 +1629,25 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_isascii HAS_ISASCII /**/ +/* HAS_ISNAN: + * This symbol, if defined, indicates that the isnan routine is + * available to check whether a double is a NaN. + */ +#$d_isnan HAS_ISNAN /**/ + +/* HAS_ISNANL: + * This symbol, if defined, indicates that the isnanl routine is + * available to check whether a long double is a NaN. + */ +#$d_isnanl HAS_ISNANL /**/ + +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +#$d_lchown HAS_LCHOWN /**/ + /* HAS_LDBL_DIG: * This symbol, if defined, indicates that this system's * or defines the symbol LDBL_DIG, which is the number @@ -1725,6 +1735,13 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_mmap HAS_MMAP /**/ #define Mmap_t $mmaptype /**/ +/* HAS_MODFL: + * This symbol, if defined, indicates that the modfl routine is + * available to split a long double x into a fractional part f and + * an integer part i such that |f| < 1.0 and (f + i) = x. + */ +#$d_modfl HAS_MODFL /**/ + /* HAS_MPROTECT: * This symbol, if defined, indicates that the mprotect system call is * available to modify the access protection of a memory mapped file. @@ -1855,12 +1872,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_setsent HAS_SETSERVENT /**/ -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. - */ -#$d_setspent HAS_SETSPENT /**/ - /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -1964,6 +1975,12 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_msg_proxy HAS_MSG_PROXY /**/ #$d_scm_rights HAS_SCM_RIGHTS /**/ +/* HAS_SOCKS5_INIT: + * This symbol, if defined, indicates that the socks5_init routine is + * available to initialize SOCKS 5. + */ +#$d_socks5_init HAS_SOCKS5_INIT /**/ + /* HAS_SQRTL: * This symbol, if defined, indicates that the sqrtl routine is * available to do long double square roots. @@ -2026,12 +2043,23 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * This symbol is defined if the FILE_cnt macro can be used as an * lvalue. */ +/* STDIO_PTR_LVAL_SETS_CNT: + * This symbol is defined if using the FILE_ptr macro as an lvalue + * to increase the pointer by n has the side effect of decreasing the + * value of File_cnt(fp) by n. + */ +/* STDIO_PTR_LVAL_NOCHANGE_CNT: + * This symbol is defined if using the FILE_ptr macro as an lvalue + * to increase the pointer by n leaves File_cnt(fp) unchanged. + */ #$d_stdstdio USE_STDIO_PTR /**/ #ifdef USE_STDIO_PTR #define FILE_ptr(fp) $stdio_ptr #$d_stdio_ptr_lval STDIO_PTR_LVALUE /**/ #define FILE_cnt(fp) $stdio_cnt #$d_stdio_cnt_lval STDIO_CNT_LVALUE /**/ +#$d_stdio_ptr_lval_sets_cnt STDIO_PTR_LVAL_SETS_CNT /**/ +#$d_stdio_ptr_lval_nochange_cnt STDIO_PTR_LVAL_NOCHANGE_CNT /**/ #endif /* USE_STDIO_BASE: @@ -2299,6 +2327,12 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_inttypes I_INTTYPES /**/ +/* I_LIBUTIL: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#$i_libutil I_LIBUTIL /**/ + /* I_MACH_CTHREADS: * This symbol, if defined, indicates to the C program that it should * include . @@ -2329,6 +2363,12 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$i_poll I_POLL /**/ +/* I_PROT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#$i_prot I_PROT /**/ + /* I_PTHREAD: * This symbol, if defined, indicates to the C program that it should * include . @@ -2491,8 +2531,18 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * This symbol, if defined, contains the string used by stdio to * format long doubles (format 'g') for output. */ +/* PERL_PRIeldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'e') for output. + */ +/* PERL_SCNfldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'f') for input. + */ #$d_PRIfldbl PERL_PRIfldbl $sPRIfldbl /**/ #$d_PRIgldbl PERL_PRIgldbl $sPRIgldbl /**/ +#$d_PRIeldbl PERL_PRIeldbl $sPRIeldbl /**/ +#$d_SCNfldbl PERL_SCNfldbl $sSCNfldbl /**/ /* Off_t: * This symbol holds the type used to declare offsets in the kernel. @@ -2580,6 +2630,16 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define Netdb_name_t $netdb_name_type /**/ #define Netdb_net_t $netdb_net_type /**/ +/* PERL_OTHERLIBDIRS: + * This variable contains a colon-separated set of paths for the perl + * binary to search for additional library files or modules. + * These directories will be tacked to the end of @INC. + * Perl will automatically search below each path for version- + * and architecture-specific directories. See PERL_INC_VERSION_LIST + * for more details. + */ +#$d_perl_otherlibdirs PERL_OTHERLIBDIRS "$otherlibdirs" /**/ + /* IVTYPE: * This symbol defines the C type used for Perl's IV. */ @@ -2643,9 +2703,16 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- /* U64SIZE: * This symbol contains the sizeof(U64). */ +/* NVSIZE: + * This symbol contains the sizeof(NV). + */ /* NV_PRESERVES_UV: * This symbol, if defined, indicates that a variable of type NVTYPE - * can preserve all the bit of a variable of type UVSIZE. + * can preserve all the bits of a variable of type UVTYPE. + */ +/* NV_PRESERVES_UV_BITS: + * This symbol contains the number of bits a variable of type NVTYPE + * can preserve of a variable of type UVTYPE. */ #define IVTYPE $ivtype /**/ #define UVTYPE $uvtype /**/ @@ -2672,7 +2739,9 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define I64SIZE $i64size /**/ #define U64SIZE $u64size /**/ #endif +#define NVSIZE $nvsize /**/ #$d_nv_preserves_uv NV_PRESERVES_UV +#define NV_PRESERVES_UV_BITS $d_nv_preserves_uv_bits /* IVdf: * This symbol defines the format string used for printing a Perl IV @@ -2688,12 +2757,27 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ /* UVxf: * This symbol defines the format string used for printing a Perl UV - * as an unsigned hexadecimal integer. + * as an unsigned hexadecimal integer in lowercase abcdef. + */ +/* NVef: + * This symbol defines the format string used for printing a Perl NV + * using %e-ish floating point format. + */ +/* NVff: + * This symbol defines the format string used for printing a Perl NV + * using %f-ish floating point format. + */ +/* NVgf: + * This symbol defines the format string used for printing a Perl NV + * using %g-ish floating point format. */ #define IVdf $ivdformat /**/ #define UVuf $uvuformat /**/ #define UVof $uvoformat /**/ #define UVxf $uvxformat /**/ +#define NVef $nveformat /**/ +#define NVff $nvfformat /**/ +#define NVgf $nvgformat /**/ /* Pid_t: * This symbol holds the type used to declare process ids in the kernel. @@ -3092,24 +3176,63 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define PERL_XS_APIVERSION "$xs_apiversion" #define PERL_PM_APIVERSION "$pm_apiversion" -/* HAS_LCHOWN: - * This symbol, if defined, indicates that the lchown routine is - * available to operate on a symbolic link (instead of following the - * link). +/* HAS_GETPGRP: + * This symbol, if defined, indicates that the getpgrp routine is + * available to get the current process group. */ -#$d_lchown HAS_LCHOWN /**/ +/* USE_BSD_GETPGRP: + * This symbol, if defined, indicates that getpgrp needs one + * arguments whereas USG one needs none. + */ +#$d_getpgrp HAS_GETPGRP /**/ +#$d_bsdgetpgrp USE_BSD_GETPGRP /**/ -/* FLEXFILENAMES: - * This symbol, if defined, indicates that the system supports filenames - * longer than 14 characters. +/* HAS_SETPGRP: + * This symbol, if defined, indicates that the setpgrp routine is + * available to set the current process group. */ -#$d_flexfnam FLEXFILENAMES /**/ +/* USE_BSD_SETPGRP: + * This symbol, if defined, indicates that setpgrp needs two + * arguments whereas USG one needs none. See also HAS_SETPGID + * for a POSIX interface. + */ +#$d_setpgrp HAS_SETPGRP /**/ +#$d_bsdsetpgrp USE_BSD_SETPGRP /**/ -/* I_LIBUTIL: - * This symbol, if defined, indicates that exists and - * should be included. +/* STDCHAR: + * This symbol is defined to be the type of char used in stdio.h. + * It has the values "unsigned char" or "char". */ -#$i_libutil I_LIBUTIL /**/ +#define STDCHAR $stdchar /**/ + +/* HAS__FWALK: + * This symbol, if defined, indicates that the _fwalk system call is + * available to apply a function to all the file handles. + */ +#$d__fwalk HAS__FWALK /**/ + +/* FCNTL_CAN_LOCK: + * This symbol, if defined, indicates that fcntl() can be used + * for file locking. Normally on Unix systems this is defined. + * It may be undefined on VMS. + */ +#$d_fcntl_can_lock FCNTL_CAN_LOCK /**/ + +/* HAS_FSYNC: + * This symbol, if defined, indicates that the fsync routine is + * available to write a file's modified data and attributes to + * permanent storage. + */ +#$d_fsync HAS_FSYNC /**/ + +/* HAS_SBRK_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the sbrk() function. Otherwise, it is up + * to the program to supply one. Good guesses are + * extern void* sbrk _((int)); + * extern void* sbrk _((size_t)); + */ +#$d_sbrkproto HAS_SBRK_PROTO /**/ #endif !GROK!THIS! diff --git a/contrib/perl5/configpm b/contrib/perl5/configpm index c64af8a13b97..31b416b7a3c1 100755 --- a/contrib/perl5/configpm +++ b/contrib/perl5/configpm @@ -128,41 +128,84 @@ sub FETCH { # Search for it in the big string my($value, $start, $marker, $quote_type); - $marker = "$_[1]="; + $quote_type = "'"; - # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m); - # Check for the common case, ' delimeted - $start = index($config_sh, "\n$marker$quote_type"); - # If that failed, check for " delimited - if ($start == -1) { - $quote_type = '"'; - $start = index($config_sh, "\n$marker$quote_type"); + # Virtual entries. + if ($_[1] eq 'byteorder') { + # byteorder does exist on its own but we overlay a virtual + # dynamically recomputed value. + my $t = $Config{ivtype}; + my $s = $Config{ivsize}; + my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I'; + if ($s == 4 || $s == 8) { + my $i = 0; + foreach my $c (reverse(2..$s)) { $i |= ord($c); $i <<= 8 } + $i |= ord(1); + $value = join('', unpack('a'x$s, pack($f, $i))); + } else { + $value = '?'x$s; + } + } elsif ($_[1] =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) { + # These are purely virtual, they do not exist, but need to + # be computed on demand for largefile-incapable extensions. + my $key = "${1}_uselargefiles"; + $value = $Config{$1}; + my $withlargefiles = $Config{$key}; + if ($key =~ /^(?:cc|ld)flags_/) { + $value =~ s/\Q$withlargefiles\E\b//; + } elsif ($key =~ /^libs/) { + my @lflibswanted = split(' ', $Config{libswanted_uselargefiles}); + if (@lflibswanted) { + my %lflibswanted; + @lflibswanted{@lflibswanted} = (); + if ($key =~ /^libs_/) { + my @libs = grep { /^-l(.+)/ && + not exists $lflibswanted{$1} } + split(' ', $Config{libs}); + $Config{libs} = join(' ', @libs); + } elsif ($key =~ /^libswanted_/) { + my @libswanted = grep { not exists $lflibswanted{$_} } + split(' ', $Config{libswanted}); + $Config{libswanted} = join(' ', @libswanted); + } + } + } + } else { + $marker = "$_[1]="; + # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m); + # Check for the common case, ' delimeted + $start = index($config_sh, "\n$marker$quote_type"); + # If that failed, check for " delimited + if ($start == -1) { + $quote_type = '"'; + $start = index($config_sh, "\n$marker$quote_type"); + } + return undef if ( ($start == -1) && # in case it's first + (substr($config_sh, 0, length($marker)) ne $marker) ); + if ($start == -1) { + # It's the very first thing we found. Skip $start forward + # and figure out the quote mark after the =. + $start = length($marker) + 1; + $quote_type = substr($config_sh, $start - 1, 1); + } + else { + $start += length($marker) + 2; + } + $value = substr($config_sh, $start, + index($config_sh, "$quote_type\n", $start) - $start); } - return undef if ( ($start == -1) && # in case it's first - (substr($config_sh, 0, length($marker)) ne $marker) ); - if ($start == -1) { - # It's the very first thing we found. Skip $start forward - # and figure out the quote mark after the =. - $start = length($marker) + 1; - $quote_type = substr($config_sh, $start - 1, 1); - } - else { - $start += length($marker) + 2; - } - $value = substr($config_sh, $start, - index($config_sh, "$quote_type\n", $start) - $start); - # If we had a double-quote, we'd better eval it so escape # sequences and such can be interpolated. Since the incoming # value is supposed to follow shell rules and not perl rules, # we escape any perl variable markers if ($quote_type eq '"') { - $value =~ s/\$/\\\$/g; - $value =~ s/\@/\\\@/g; - eval "\$value = \"$value\""; + $value =~ s/\$/\\\$/g; + $value =~ s/\@/\\\@/g; + eval "\$value = \"$value\""; } #$value = sprintf($value) if $quote_type eq '"'; - $value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}". + # So we can say "if $Config{'foo'}". + $value = undef if $value eq 'undef'; $_[0]->{$_[1]} = $value; # cache it return $value; } @@ -191,7 +234,8 @@ sub EXISTS { index($config_sh, "\n$_[1]='") != -1 or substr($config_sh, 0, length($_[1])+2) eq "$_[1]='" or index($config_sh, "\n$_[1]=\"") != -1 or - substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\""; + substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"" or + $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/; } sub STORE { die "\%Config::Config is read-only\n" } diff --git a/contrib/perl5/configure.com b/contrib/perl5/configure.com index 003a047bbe87..62ebaccb1cba 100644 --- a/contrib/perl5/configure.com +++ b/contrib/perl5/configure.com @@ -1,7 +1,7 @@ $ sav_ver = 'F$VERIFY(0)' $! SET VERIFY $! -$! For example, if you unpacked perl into: [USER.PERL5_00n...] then you will +$! For example, if you unpacked perl into: [USER.PERL-5n...] then you will $! want to cd into the tree and execute Configure: $! $! $ SET DEFAULT [USER.PERL5_xxx] @@ -30,12 +30,12 @@ $! with much valuable help from Charles Bailey & $! the whole VMSPerl crew. $! Extended and messed about with by Dan Sugalski $! -$ sav_ver = F$VERIFY(0) -$! $! VMS-isms we will need: $ echo = "write sys$output " $ cat = "type" +$ delete := delete ! local symbol overrides globals with qualifiers $ gcc_symbol = "gcc" +$ ld = "Link" $ ans = "" $ macros = "" $ extra_flags = "" @@ -50,12 +50,20 @@ $ Thread_Live_Dangerously = "MT=" $ use_two_pot_malloc = "N" $ use_pack_malloc = "N" $ use_debugmalloc = "N" -$ d_secintgenv = "N" -$ cc_flags = "" -$ use_multiplicity = "N" +$ ccflags = "" +$ static_ext = "" $ vms_default_directory_name = F$ENVIRONMENT("DEFAULT") -$ max_allowed_dir_depth = 3 ! e.g. [A.B.PERL5_xxx] not [A.B.C.PERL5_xxx] -$! max_allowed_dir_depth = 2 ! e.g. [A.PERL5_xxx] not [A.B.PERL5_xxx] +$ max_allowed_dir_depth = 3 ! e.g. [A.B.PERLxxx] not [A.B.C.PERLxxx] +$! max_allowed_dir_depth = 2 ! e.g. [A.PERLxxx] not [A.B.PERLxxx] +$! +$! Sebastian Bazley's request: close the CONFIG handle with /NOLOG +$! qualifier "just in case" (configure.com is re @ed in a bad state). +$! This construct was tested to be not a problem as far back as +$! VMS V5.5-2, hopefully earlier versions are OK as well. +$! +$ CLOSE/NOLOG CONFIG +$! +$! Now keep track of open files $! $ vms_filcnt = F$GETJPI ("","FILCNT") $! @@ -118,16 +126,16 @@ $!: set up default values $ fastread="" $ reuseval="false" $ maniskip = "false" -$ config_sh="" +$ IF F$TYPE(config_sh) .EQS. "" THEN config_sh="" $ alldone="" $ error="" $ silent="" $ extractsh="" $ override="" $ knowitall="" -$ Using_Dec_C = "" -$ Using_Gnu_C = "" +$ ccname="VAX" $ Dec_C_Version = "" +$ cxxversion = "" $ use_threads = "F" $ use_5005_threads = "N" $ use_ithreads = "N" @@ -170,7 +178,7 @@ $ gotopt = "t" $ P'i' = P'i' - "e" $ gotshortopt = "t" $ ENDIF -$ IF (F$EXTRACT(0,1,P'i') .EQS. "f") !"-f") +$ IF (F$EXTRACT(0,1,P'i') .EQS. "f") ! "-f" $ THEN $ P'i' = P'i' - "f" $ config_sh = P'i' @@ -179,6 +187,7 @@ $ THEN $ test_config_sh = F$FILE_ATTRIBUTES(config_sh,"PRO") $ IF (F$LOCATE("R",test_config_sh).NE.F$LENGTH(test_config_sh)) $ THEN +$ config_dflt = "y" $ CONTINUE !at this point check UIC && if test allows... $ !to be continued ? $ ELSE @@ -191,100 +200,103 @@ $ error="true" $ ENDIF $ gotopt = "t" $ ENDIF -$ IF (F$EXTRACT(0,1,P'i') .EQS. "h") +$ IF (F$EXTRACT(0,1,P'i') .EQS. "h") ! "-h" $ THEN $ error = "true" $ gotopt = "t" $ P'i' = P'i' - "h" $ gotshortopt = "t" $ ENDIF -$ IF (F$EXTRACT(0,1,P'i') .EQS. "m") +$ IF (F$EXTRACT(0,1,P'i') .EQS. "m") ! "-m" $ THEN $ maniskip = "true" $ gotopt = "t" $ P'i' = P'i' - "m" $ gotshortopt = "t" $ ENDIF -$ IF (F$EXTRACT(0,1,P'i') .EQS. "r") +$ IF (F$EXTRACT(0,1,P'i') .EQS. "r") ! "-r" $ THEN $ reuseval = "true" $ gotopt = "t" $ P'i' = P'i' - "r" $ gotshortopt = "t" $ ENDIF -$ IF (F$EXTRACT(0,1,P'i') .EQS. "s") +$ IF (F$EXTRACT(0,1,P'i') .EQS. "s") ! "-s" $ THEN $ silent = "true" $ gotopt = "t" $ P'i' = P'i' - "s" $ gotshortopt = "t" $ ENDIF -$ IF (F$EXTRACT(0,1,P'i') .EQS. "E") !"-E") +$ IF (F$EXTRACT(0,1,P'i') .EQS. "E") ! "-E" $ THEN $ alldone = "exit" $ gotopt = "t" $ ENDIF -$ IF (F$EXTRACT(0,1,P'i') .EQS. "K") !"-K") +$ IF (F$EXTRACT(0,1,P'i') .EQS. "K") ! "-K" $ THEN $ knowitall = "true" $ gotopt = "t" $ P'i' = P'i' - "K" $ gotshortopt = "t" $ ENDIF -$ IF (F$EXTRACT(0,1,P'i') .EQS. "O") +$ IF (F$EXTRACT(0,1,P'i') .EQS. "O") ! "-O" $ THEN $ override = "true" $ gotopt = "t" $ P'i' = P'i' - "O" $ gotshortopt = "t" $ ENDIF -$ IF (F$EXTRACT(0,1,P'i') .EQS. "S") !"-S") +$ IF (F$EXTRACT(0,1,P'i') .EQS. "S") ! "-S" $ THEN -$ extractsh = "true" !VMS? +$ extractsh = "true" !VMS? Yes with munchconfig $ gotopt = "t" $ P'i' = P'i' - "S" $ gotshortopt = "t" $ ENDIF -$ IF (F$EXTRACT(0,1,P'i') .EQS. "D") !"-D") +$ IF (F$EXTRACT(0,1,P'i') .EQS. "D") ! "-D" $ THEN $ P'i' = P'i' - "D" -$!Hmm.. this part needs work -$! P'i' $ IF (F$LOCATE("=",P'i') .EQ. F$LENGTH(P'i')) $ THEN -$ P'i' = "define" +$ tmp = P'i' + "=""define""" +$ 'tmp' +$ DELETE/SYMBOL tmp $ ELSE $ IF (F$LOCATE("=",P'i') .EQ. (F$LENGTH(P'i') - 1)) $ THEN $ me = F$PARSE(me,,,"NAME") + F$PARSE(me,,,"TYPE") -$ echo "''me': use '-Usymbol=val' not '-Dsymbol='." +$ echo "''me': use ""-Usymbol=val"" not ""-Dsymbol=""." $ echo "''me': ignoring -D",P'i' $ ELSE -$!Hmm.. this part needs work -$! 'F$EXTRACT(0,F$LOCATE("=",P'i'),P'i')' = - -$! 'F$EXTRACT(F$LOCATE("=",P'i'),P'i'),F$LENGTH(P'i'),P'i')' +$ tmp = F$EXTRACT(0,F$LOCATE("=",P'i'),P'i') +$ tmp = tmp + "=""" + F$EXTRACT(F$LOCATE("=",P'i')+1,F$LENGTH(P'i'),P'i') + """" +$ 'tmp' +$ DELETE/SYMBOL tmp $ ENDIF $ ENDIF -$ ECHO "P''i' =>",P'i',"<=" !Diag $ gotopt = "t" $ ENDIF -$ IF (F$EXTRACT(0,1,P'i') .EQS. "U") !"-U") +$ IF (F$EXTRACT(0,1,P'i') .EQS. "U") ! "-U" $ THEN $ P'i' = P'i' - "U" $ IF (F$LOCATE("=",P'i') .EQ. F$LENGTH(P'i')) $ THEN -$ P'i' = "" +$ tmp = P'i' + "=""""" +$ 'tmp' +$ DELETE/SYMBOL tmp $ ELSE $ IF (F$LOCATE("=",P'i') .LT. (F$LENGTH(P'i') - 1)) $ THEN $ me = F$PARSE(me,,,"NAME") + F$PARSE(me,,,"TYPE") -$ echo "''me': use '-Dsymbol=val' not '-Usymbol=val'." +$ echo "''me': use ""-Dsymbol=val"" not ""-Usymbol=val""." $ echo "''me': ignoring -U",P'i' $ ELSE -$ P'i' = "undef" +$ tmp = P'i' + "=""undef""" +$ 'tmp' +$ DELETE/SYMBOL tmp $ ENDIF $ ENDIF -$ ECHO "P''i' =>",P'i',"<=" !Diag $ gotopt = "t" $ ENDIF $ IF (F$EXTRACT(0,1,P'i') .EQS. "V") @@ -292,7 +304,7 @@ $ THEN $ me = F$PARSE(me,,,"NAME") + F$PARSE(me,,,"TYPE") $ echo "''me' generated by an unknown version of EDT." $ STOP -$ EXIT !0 +$ EXIT $ ENDIF $ IF .NOT.gotopt $ THEN @@ -309,9 +321,10 @@ $! $ IF (error) $ THEN $ me = F$PARSE(me,,,"DIRECTORY")+ F$PARSE(me,,,"NAME") -$ echo "Usage: @''me' [-dehmrEKOSV] [-fconfig.sh] [-Dsymbol] [-Dsymbol=value]" +$ echo "Usage: @''me' [-dehmr""EKOSV""] [-fconfig.sh] [""-Dsymbol""] [""-Dsymbol=value""]" $ echo " [-Usymbol] [-Usymbol=]" -$ TYPE SYS$INPUT +$ TYPE SYS$INPUT: +$ DECK "-d" : use defaults for all answers. "-e" : go on without questioning past the production of config.sh. * "-f" : specify an alternate default configuration file. @@ -330,6 +343,7 @@ $ TYPE SYS$INPUT -"Usymbol" symbol gets the value 'undef' -"Usymbol=" symbol gets completely empty -V : print version number and exit (with a zero status). +$ EOD $ echo "%Config-I-VMS, lower case switches must be enclosed" $ echo "-Config-I-VMS, in double quotation marks, e.g.:" $ echo "-Config-I-VMS, @Configure ""-des""" @@ -344,7 +358,8 @@ $! $Shut_up: $ IF F$Mode() .eqs. "BATCH" $ THEN -$ STDOUT = F$GetQuI("DISPLAY_JOB","LOG_SPECIFICATION",,"THIS_JOB") +$ STDOUT = F$PARSE(F$GETQUI("DISPLAY_ENTRY", "JOB_NAME"), - + F$GETQUI("DISPLAY_ENTRY", "LOG_SPECIFICATION"), ".LOG") $ WRITE SYS$OUTPUT "Warning: Executing in batch mode. To avoid file locking conflicts," $ WRITE SYS$OUTPUT "output intended for SYS$OUTPUT will be sent to a new version" $ WRITE SYS$OUTPUT STDOUT @@ -393,7 +408,7 @@ $ echo "" $ echo4 "First let's make sure your kit is complete. Checking..." $ manifestfound = "" $ miss_list = "" -$! Here I assume we are in the [foo.PERL5xxx.VMS...] tree +$! Here I assume we are in the [foo.PERLxxx...] tree $! because the search routine simply does set def [-] if necessary. $ file_2_find = "MANIFEST" !I hope this one is not in [foo.PERL5xxx.VMS...] $Research_manifest: @@ -418,10 +433,12 @@ $ IF (tmp .GES. "7.2") .AND. (F$GETSYI("HW_MODEL") .GE. 1024) THEN GOTO Beyond_d $ IF (F$ELEMENT(max_allowed_dir_depth,".",F$ENVIRONMENT("Default")).nes.".") $ THEN $ TYPE SYS$INPUT: +$ DECK %Config-E-VMS, ERROR: Sorry! It apears as though your perl build sub-directory is already too deep into the VMS file system. Please try moving stuff into a shallower directory (or altering the "max_allowed_dir_depth" parameter). +$ EOD $ echo4 "ABORTING..." $ SET DEFAULT 'vms_default_directory_name' !be kind rewind $ STOP @@ -537,6 +554,8 @@ $ ENDIF $ IF ((miss_list .NES. "").OR.(manifestfound .EQS. "")) $ THEN $ TYPE SYS$INPUT: +$ DECK + THIS PACKAGE SEEMS TO BE INCOMPLETE. @@ -545,6 +564,7 @@ distinct possibility that your kit is damaged, by typing 'y'es. If you do, don't blame me if something goes wrong. I advise you to type 'n'o and contact the author (dan@sidhe.org) +$ EOD $ READ SYS$COMMAND/PROMPT="Continue? [n] " ans $ IF ans $ THEN @@ -575,13 +595,23 @@ $ If (fastread) $ Then $ echo4 "''rp'" $ Else -$ If (silent) -$ Then +$ If (.NOT. silent) Then echo "" +$ READ SYS$COMMAND/PROMPT="''rp'" ans +$ IF (ans .EQS. "&-d") +$ THEN +$ echo4 "(OK, I will run with -d after this question.)" +$ IF (.NOT. silent) THEN echo "" $ READ SYS$COMMAND/PROMPT="''rp'" ans -$ Else +$ fastread := yes +$ ENDIF +$ IF (ans .EQS. "&-s") +$ THEN +$ echo4 "(OK, I will run with -s after this question.)" $ echo "" $ READ SYS$COMMAND/PROMPT="''rp'" ans -$ Endif +$ silent := true +$ GOSUB Shut_up +$ ENDIF $ Endif $ RETURN $! @@ -602,6 +632,58 @@ $ WRITE CONFIG - $ CLOSE CONFIG $ ENDIF $! +$ IF F$TYPE(usedevel) .EQS. "" THEN usedevel := n +$ patchlevel_h = F$SEARCH("[-]patchlevel.h") +$ IF (patchlevel_h.NES."") +$ THEN +$ SEARCH 'patchlevel_h' "define","PERL_VERSION","epoch"/match=and/out=[]ver.out +$ IF .NOT. usedevel .AND. usedevel .NES. "define" +$ THEN +$ OPEN/READ CONFIG []ver.out +$ READ CONFIG line +$ CLOSE CONFIG +$ tmp = F$EDIT(line,"TRIM,COMPRESS") +$ xpatchlevel = F$INTEGER(F$ELEMENT(2," ",tmp)) +$ line = xpatchlevel / 2 +$ tmp = xpatchlevel - ( line * 2 ) +$ IF tmp .NE. 0 +$ THEN +$ echo4 "patchlevel is " + F$STRING(xpatchlevel) +$ cat4 SYS$INPUT: +$ DECK +*** WHOA THERE!!! *** + + This is an UNSTABLE DEVELOPMENT release. + (The patchlevel, is odd--as opposed to even, + and that signifies a development release. If you want a + maintenance release, you want an even-numbered release.) + + Do ***NOT*** install this into production use. + Data corruption and crashes are possible. + + It is most seriously suggested that you do not continue any further + unless you want to help in developing and debugging Perl. + +$ EOD +$ dflt="n" +$ rp="Do you really want to continue? [''dflt'] " +$ IF (fastread) THEN fastread := FALSE +$ GOSUB myread +$ IF ans .EQS. "" THEN ans = dflt +$ IF ans +$ THEN +$ echo4 "Okay, continuing." +$ ELSE +$ echo4 "Okay, bye." +$ DELETE/NOLOG/NOCONFIRM []ver.out; +$ GOTO Clean_up +$ ENDIF +$ ENDIF +$ DELETE/SYMBOL line +$ DELETE/SYMBOL tmp +$ ENDIF +$ DELETE/NOLOG/NOCONFIRM []ver.out; +$ ENDIF $!: general instructions $ needman = "true" $ firsttime = "true" @@ -626,6 +708,7 @@ $! $ IF (needman) $ THEN $ TYPE SYS$INPUT: +$ DECK This installation shell script will examine your system and ask you questions to determine how the perl5 package should be installed. If you get @@ -634,16 +717,20 @@ process, edit something, then restart this process as you just did. Many of the questions will have default answers in square brackets; typing carriage return will give you the default. +$ EOD $ READ SYS$COMMAND/PROMPT="Type carriage return to continue " ans $ TYPE SYS$INPUT: +$ DECK In a hurry? You may run '@Configure "-d"'. This will bypass nearly all the questions and use the computed defaults (or the previous answers provided there was already a config.sh file). Type '@Configure "-h"' for a list of options. +$ EOD $ READ SYS$COMMAND/PROMPT="Type carriage return to continue " ans $ TYPE SYS$INPUT: +$ DECK Much effort has been expended to ensure that this shell script will run on any VMS system. If despite that it blows up on yours, your @@ -651,6 +738,7 @@ best bet is to edit Configure.com and @ it again. Whatever problems you have with Configure.com, let me (dan@sidhe.org) know how I blew it. +$ EOD $!This installation script affects things in two ways: $! $!1) it may do direct variable substitutions on some of the files included @@ -675,7 +763,7 @@ $ sharpbang = "$ " $!: figure out how to guarantee sh startup !sfn $!: find out where common programs are !sfn $!loclist="awk/cat/comm/cp/echo/expr/find/grep/ln/ls/mkdir/rm/sed/sort/touch/tr/uniq" -$!trylist="Mcc/byacc/cpp/csh/date/egrep/less/line/more/nroff/perl/pg/sendmail/test/uname" +$!trylist="byacc/cpp/csh/date/egrep/less/line/more/nroff/perl/pg/sendmail/test/uname" $! echo "I don't know where '$file' is, and my life depends on it." $! echo "Go find a public domain implementation or fix your PATH setting!" $! echo "" @@ -699,15 +787,49 @@ $ configshfound = F$SEARCH(config_sh) $ IF (configshfound.NES."") THEN GOTO Config_sh_found $ ENDIF $ IF (i.LT.max) THEN GOTO Config_sh_look -$ IF (configshfound.EQS."") THEN GOTO Beyond_config_sh +$! genconfig.pl has "osname='VMS'" +$ osname = F$EDIT(F$GETSYI("NODE_SWTYPE"),"COLLAPSE") +$ IF (configshfound.EQS."") +$ THEN +$ config_sh = "[-]config.sh" ! the fallback default +$ GOTO Beyond_config_sh +$ ENDIF $Config_sh_found: -$ echo "" -$ echo "Fetching default answers from ''config_sh'..." +$ IF F$TYPE(osname) .EQS. "" THEN osname = F$EDIT(F$GETSYI("NODE_SWTYPE"),"COLLAPSE") +$ IF F$TYPE(config_dflt) .EQS. "" THEN config_dflt = "n" +$ rp = "Shall I @ ''config_sh' for default answers? [''config_dflt'] " +$ GOSUB myread +$ IF ans .EQS. "" THEN ans = config_dflt +$ IF ans +$ THEN +$ echo "" +$ echo "Fetching default answers from ''config_sh'..." +$! +$! This @ is why config_sh must employ DCL syntax. Note that for +$! symbols to be returned to this procedure they must be global. +$! Which implies that assignments must be of the :== or == variety. +$! Note further that the [-]config.sh file written by this procedure +$! employs shell syntax. In order to convert shell syntax to DCL +$! you might try: +$! +$! perl -ni -e "s/^#/!#/;s/='/==""/;s/'$/""/;print ""\$ $_"";" config.sh +$! +$! However, watch out for sig_nam, sig_nam_init, sig_num, startperl +$! and any of the lower case double quoted variables such as the *format +$! variables in such a config."sh". +$! +$ @'config_sh' +$! +$ ENDIF +$ DELETE/SYMBOL config_dflt +$! $!we actually do not have "hints/" for VMS $! TYPE SYS$INPUT: +$! DECK $! $!First time through, eh? I have some defaults handy for the following systems: $! +$! EOD $! echo " ","VMS_VAX" $! echo " ","VMS_AXP" $! : Now look for a hint file osname_osvers, unless one has been @@ -723,20 +845,20 @@ $Beyond_config_sh: $! $!: Restore computed paths !sfn $! -$! genconfig.pl has "osname='VMS'" -$ osname = F$EDIT(F$GETSYI("NODE_SWTYPE"),"COLLAPSE") $! %Config-I-VMS, a necessary error trap (could be PC running VCL) $! $ IF (osname .NES. "VMS") $ THEN $ echo4 "Hmm.. I wonder what ''osname' is (?)" $ TYPE SYS$INPUT: +$ DECK %Config-E-VMS, ERROR: Err, you do not appear to be running VMS! This procedure is intended to Configure the building of Perl for VMS. +$ EOD $ READ SYS$COMMAND/PROMPT="Continue anyway? [n] " ans $ IF ans $ THEN @@ -750,11 +872,13 @@ $ ENDIF $ ELSE !we are on VMS huzzah! $ IF .NOT.silent $ THEN TYPE SYS$INPUT: +$ DECK Configure uses the operating system name and version to set some defaults. The default value is probably right if the name rings a bell. Otherwise, since spelling matters for me, either accept the default or answer "none" to leave it blank. +$ EOD $ ENDIF $ rp = "Operating system name? [''osname'] " $ GOSUB myread @@ -768,9 +892,7 @@ $ ENDIF $ ENDIF !(osname .NES./.EQS. "VMS") $! $!: who configured the system -$! see 'user' above. $ cf_by = F$EDIT(user,"LOWERCASE") -$! cf_time = F$CVTIME() !superceded by procedure below $ osvers = F$EDIT(F$GETSYI("VERSION"),"TRIM") $! $! Peter Prymmer has seen: @@ -793,7 +915,6 @@ $! "WIN$Time_Zone" $! $! This snippet o' DCL returns a string in default Unix `date` format, $! and it will prompt to set SYS$TIMEZONE_DIFFERENTIAL. -$! Peter Prymmer pvhp@lns62.lns.cornell.edu $! $ MIN_TZO = -840 !units are minutes here $ MAX_TZO = 840 @@ -832,7 +953,6 @@ $ tzhour = -1*tzhour !keeps !UL happy $ direction = "west of " $ ENDIF $ echo "" -$ echo "%Config-I-VMS," $ echo "According to the setting of your ""SYS$TIMEZONE_DIFFERENTIAL"" (= ''systz')" $ IF tzminrem.ne.0 $ THEN @@ -842,7 +962,7 @@ $ tzspan = "''tzhour' hours" $ ENDIF $ dflt = "y" $ echo "Your system is ''tzspan' ''direction'UTC in England." -$ rp = "%Config-I-VMS, (''systz') Is this UTC Time Zone Offset correct? [''dflt'] " +$ rp = "(''systz') Is this UTC Time Zone Offset correct? [''dflt'] " $ GOSUB myread $ IF ans.OR.(ans.EQS."") $ THEN @@ -852,7 +972,6 @@ $ GOTO Beyond_TimeZone $ ENDIF $ ELSE $ echo "" -$ echo4 "%Config-I-VMS," $ echo4 """SYS$TIMEZONE_DIFFERENTIAL"" does not appear to be DEFINEd on your system" $ ENDIF $! @@ -899,6 +1018,8 @@ $ cf_time = "''wkday' ''mon' ''mday' ''hour':''min':''sec' ''tz' ''year'" $! $!: determine the architecture name $! genconfig.pl has either archname='VMS_AXP' or 'VMS_VAX' +$! Note that DCL in VMS V5.4 does not have F$GETSYI("ARCH_NAME") +$! but does have F$GETSYI("HW_MODEL"). $! $ IF (F$GETSYI("HW_MODEL") .LT. 1024) $ THEN @@ -923,7 +1044,9 @@ $ echo4 "I'll go with ''archname' anyway..." $ ENDIF $ ENDIF $ dflt = "n" -$ rp = "Will you be sharing your PERL_ROOT with ''otherarch'? [''dflt'] " +$ vms_prefix = "perl_root" +$ vms_prefixup = F$EDIT(vms_prefix,"UPCASE") +$ rp = "Will you be sharing your ''vms_prefixup' with ''otherarch'? [''dflt'] " $ GOSUB myread $ if ans.NES."" $ THEN @@ -946,22 +1069,26 @@ $!: set up shell script to do ~ expansion !sfn $!: expand filename !sfn $!: now set up to get a file name !sfn $! -$ prefix = F$ENVIRONMENT("DEFAULT") - ".UU]" + "]" -$ prefix = F$PARSE(prefix,,,,"NO_CONCEAL") - "][" - ".;" -$ prefixbase = prefix - "]" -$ prefix = prefixbase + ".]" +$ IF F$TYPE(prefix) .EQS. "" +$ THEN +$ prefix = F$ENVIRONMENT("DEFAULT") - ".UU]" + "]" +$ prefix = F$PARSE(prefix,,,,"NO_CONCEAL") - "][" - ".;" +$ prefixbase = prefix - "]" +$ prefix = prefixbase + ".]" +$ ENDIF +$ src = prefix $!: determine root of directory hierarchy where package will be installed. $ dflt = prefix $ IF .NOT.silent $ THEN $ echo "" $ echo "By default, ''package' will be installed in ''dflt', pod" -$ echo "pages under ''prefixbase'LIB.POD], etc..., i.e. with ''dflt' as prefix for" +$ echo "pages under ''prefixbase'.LIB.POD], etc..., i.e. with ''dflt' as prefix for" $ echo "all installation directories." -$ echo "On ''osname' the ''prefix' is used to DEFINE the ''packageup'_ROOT prior to installation" +$ echo "On ''osname' the prefix is used to DEFINE the ''vms_prefixup' prior to installation" $ echo "as well as during subsequent use of ''package' via ''packageup'_SETUP.COM." $ ENDIF -$ rp = "Installation prefix to use (for ''packageup'_ROOT)? [ ''dflt' ] " +$ rp = "Installation prefix to use (for ''vms_prefixup')? [ ''dflt' ] " $ GOSUB myread $ IF ans.NES."" $ THEN @@ -970,6 +1097,7 @@ $ IF F$LOCATE(".]",ans) .EQ. F$LENGTH(ans) THEN prefix = prefix - "]" + ".]" $ ELSE $ prefix = dflt $ ENDIF +$ perl_root = prefix $! $! Check here for pre-existing PERL_ROOT. $! -> ask if removal desired. @@ -979,7 +1107,7 @@ $! $ vms_skip_install = "true" $ dflt = "y" $! echo "" -$ rp = "%Config-I-VMS, Skip the remaining """"where install"""" questions? [''dflt'] " +$ rp = "Skip the remaining """"where install"""" questions? [''dflt'] " $ GOSUB myread $ IF (.NOT.ans).AND.(ans.NES."") THEN vms_skip_install = "false" $ IF (.NOT.vms_skip_install) @@ -991,12 +1119,18 @@ $!: determine where private library files go $!: Usual default is /usr/local/lib/perl5. Also allow things like $!: /opt/perl/lib, since /opt/perl/lib/perl5 would be redundant. $ IF .NOT.silent -$ THEN TYPE SYS$INPUT: +$ THEN +$ TYPE SYS$INPUT: +$ DECK There are some auxiliary files for perl5 that need to be put into a private library directory that is accessible by everyone. +$ EOD +$ ENDIF +$ IF F$TYPE(privlib) .NES. "" +$ THEN dflt = privlib +$ ELSE dflt = "''vms_prefix':[lib]" $ ENDIF -$ dflt = prefix - ".]" + ".LIB]" $ rp = "Pathname where the private library files will reside? " $ rp = F$FAO("!AS!/!AS",rp,"[ ''dflt' ] ") $ GOSUB myread @@ -1013,12 +1147,12 @@ $ dflt = "y" $ IF .NOT.silent $ THEN $ echo "" -$ echo "%Config-I-VMS, You may choose to write ''packageup'_SETUP.COM to assign a foreign" -$ echo "-Config-I-VMS, symbol to invoke ''package', which is the usual method." -$ echO "-Config-I-VMS, If you do not do so then you would need a DCL command verb at the" -$ echo "-Config-I-VMS, process or the system wide level." +$ echo "You may choose to write ''packageup'_SETUP.COM to assign a foreign" +$ echo "symbol to invoke ''package', which is the usual method." +$ echO "If you do not do so then you would need a DCL command verb at the" +$ echo "process or the system wide level." $ ENDIF -$ rp = "Invoke perl as a global symbol foreign command [''dflt'] " +$ rp = "Invoke perl as a global symbol foreign command? [''dflt'] " $ GOSUB myread $ IF (.NOT.ans).AND.(ans.NES."") THEN perl_symbol = "false" $! @@ -1028,11 +1162,11 @@ $ dflt = "y" $ IF .NOT.silent $ THEN $ echo "" -$ echo "%Config-I-VMS, Since you won't be using a symbol you must choose to put the ''packageup'" -$ echo "-Config-I-VMS, verb in a per-process table or in the system wide DCLTABLES (which" -$ echo "-Config-I-VMS, would require write privilege)." +$ echo "Since you won't be using a symbol you must choose to put the ''packageup'" +$ echo "verb in a per-process table or in the system wide DCLTABLES (which" +$ echo "would require write privilege)." $ ENDIF -$ rp = "Invoke perl as a per process command verb [ ''dflt' ] " +$ rp = "Invoke perl as a per process command verb? [ ''dflt' ] " $ GOSUB myread $ IF (.NOT.ans).AND.(ans.NES."") $ THEN perl_verb = "DCLTABLES" @@ -1045,7 +1179,7 @@ $ baserev="5.0" $ revision = baserev - ".0" $!: get the patchlevel $ echo "" -$ echo4 "Getting the current patchlevel..." !>&4 +$ echo4 "Getting the current patchlevel..." $ patchlevel_h = F$SEARCH("[-]patchlevel.h") $ IF (patchlevel_h.NES."") $ THEN @@ -1056,7 +1190,7 @@ $ got_api_version = "false" $ got_api_subversion = "false" $ OPEN/READONLY CONFIG 'patchlevel_h' $Patchlevel_h_loop: -$ READ/END_Of_File=Close_patch CONFIG line +$ READ/END_Of_File=Close_patch/ERROR=Close_patch CONFIG line $ IF ((F$LOCATE("#define PERL_VERSION",line).NE.F$LENGTH(line)).AND.(.NOT.got_patch)) $ THEN $ line = F$EDIT(line,"COMPRESS, TRIM") @@ -1087,12 +1221,20 @@ $ line = F$EDIT(line,"COMPRESS, TRIM") $ api_subversion = F$ELEMENT(2," ",line) $ got_api_subversion = "true" $ ENDIF -$ IF (.NOT.got_patch).OR.(.NOT.got_sub) THEN GOTO Patchlevel_h_loop +$ IF (.NOT. got_patch) .OR. - + (.NOT. got_sub) .OR. - + (.NOT. got_api_revision) .OR. - + (.NOT. got_api_version) .OR. - + (.NOT. got_api_subversion) - + THEN GOTO Patchlevel_h_loop $Close_patch: $ CLOSE CONFIG -$ ELSE -$ patchlevel="0" -$ subversion="0" +$ ELSE +$ patchlevel="0" +$ subversion="0" +$ api_revision="0" +$ api_version="0" +$ api_subversion="0" $ ENDIF $ IF (F$STRING(subversion) .NES. "0") $ THEN @@ -1105,7 +1247,6 @@ $ version = revision + "_" + patchlevel + "_" + subversion $! $ IF (.NOT.vms_skip_install) $ THEN -$!: set the prefixup variable, to restore leading tilda escape !sfn $!: set the prefixup variable, to restore leading tilde escape !sfn $! $!: determine where public architecture dependent libraries go @@ -1115,12 +1256,18 @@ $ echo "" $ echo "''package' contains architecture-dependent library files. If you are" $ ENDIF $ IF (.NOT.silent) -$ THEN TYPE SYS$INPUT: +$ THEN +$ TYPE SYS$INPUT: +$ DECK sharing libraries in a heterogeneous environment, you might store these files in a separate location. Otherwise, you can just include them with the rest of the public library files. +$ EOD +$ ENDIF +$ IF F$TYPE(archlib) .NES. "" +$ THEN dflt = archlib +$ ELSE dflt = privlib - "]" + "." + archname + "." + version + "]" $ ENDIF -$ dflt = privlib - "]" + "." + archname + "." + version + "]" $ rp = "Where do you want to put the public architecture-dependent libraries? " $ rp = F$FAO("!AS!/!AS",rp,"[ ''dflt' ] ") $ GOSUB myread @@ -1129,16 +1276,16 @@ $ THEN archlib = ans $ ELSE archlib = dflt $ ENDIF $! -$!: set up the script used to warn in case of inconsistency !sfn -$!: function used to set $1 to $val !sfn -$! $ ENDIF !%Config-I-VMS, skip "where install" questions +$! $! This quotation from Configure has to be included on VMS: +$! $ TYPE SYS$INPUT: +$ DECK There is, however, a strange, musty smell in the air that reminds me of something...hmm...yes...I've got it...there's a VMS nearby, or I'm a Blit. -$ CONTINUE +$ EOD $ IF (.NOT.vms_skip_install) $ THEN $!: it so happens the Eunice I know will not run shell scripts in Unix format @@ -1148,14 +1295,20 @@ $!: now see if they want to do setuid emulation !sfn $! $!: determine where site specific libraries go. $ IF .NOT.silent -$ THEN TYPE SYS$INPUT: +$ THEN +$ TYPE SYS$INPUT: +$ DECK The installation process will also create a directory for site-specific extensions and modules. Some users find it convenient to place all local files in this directory rather than in the main distribution directory. +$ EOD +$ ENDIF +$ IF F$TYPE(sitelib) .NES. "" +$ THEN dflt = sitelib +$ ELSE dflt = privlib - "]" + ".SITE_PERL]" $ ENDIF -$ dflt = privlib - "]" + ".SITE_PERL]" $ rp = "Pathname for the site-specific library files? " $ rp = F$FAO("!AS!/!AS",rp,"[ ''dflt' ] ") $ GOSUB myread @@ -1167,11 +1320,16 @@ $! $!: determine where site specific architecture-dependent libraries go. $ IF .NOT.silent $ THEN TYPE SYS$INPUT: +$ DECK The installation process will also create a directory for architecture-dependent site-specific extensions and modules. +$ EOD +$ ENDIF +$ IF F$TYPE(sitearch) .NES. "" +$ THEN dflt = sitearch +$ ELSE dflt = sitelib - "]" + "." + archname + "]" $ ENDIF -$ dflt = sitelib - "]" + "." + archname + "]" $ rp = "Pathname for the site-specific architecture-dependent library files? " $ rp = F$FAO("!AS!/!AS",rp,"[ ''dflt' ] ") $ GOSUB myread @@ -1183,7 +1341,11 @@ $! $!: determine where old public architecture dependent libraries might be $! $!: determine where public executables go -$ dflt = prefix - ".]" + ".BIN]" +$ IF F$TYPE(bin) .NES. "" +$ THEN dflt = bin +$! ELSE dflt = prefix - ".]" + ".BIN]" +$ ELSE dflt = "/''vms_prefix'/000000" +$ ENDIF $ rp = "Pathname where the public executables will reside? " $ rp = F$FAO("!AS!/!AS",rp,"[ ''dflt' ] ") $ GOSUB myread @@ -1199,8 +1361,57 @@ $!: determine where library module manual pages go $!: What suffix to use on installed man pages $!: see what memory models we can support $! +$ ELSE ! skipping "where install" questions, we must set some symbols +$ IF F$TYPE(archlib).EQS."" THEN - + archlib="''vms_prefix':[lib.''archname'.''version']" +$ IF F$TYPE(bin) .EQS. "" THEN - + bin="/''vms_prefix'/000000" +$ IF F$TYPE(privlib) .EQS. "" THEN - + privlib ="''vms_prefix':[lib]" +$ IF F$TYPE(sitearch) .EQS. "" THEN - + sitearch="''vms_prefix':[lib.site_perl.''archname']" +$ IF F$TYPE(sitelib) .EQS. "" THEN - + sitelib ="''vms_prefix':[lib.site_perl]" $ ENDIF !%Config-I-VMS, skip "where install" questions $! +$! These derived locations can be set whether we've opted to +$! skip the where install questions or not. +$! +$ IF F$TYPE(archlibexp) .EQS. "" THEN - + archlibexp="''vms_prefix':[lib.''archname'.''version']" +$ IF F$TYPE(binexp) .EQS. "" THEN - + binexp ="''vms_prefix':[000000]" +$ IF F$TYPE(builddir) .EQS. "" THEN - + builddir ="''vms_prefix':[000000]" +$ IF F$TYPE(installarchlib) .EQS. "" THEN - + installarchlib="''vms_prefix':[lib.''archname'.''version']" +$ IF F$TYPE(installbin) .EQS. "" THEN - + installbin ="''vms_prefix':[000000]" +$ IF F$TYPE(installscript) .EQS. "" THEN - + installscript ="''vms_prefix':[utils]" +$ IF F$TYPE(installman1dir) .EQS. "" THEN - + installman1dir ="''vms_prefix':[man.man1]" +$ IF F$TYPE(installman3dir) .EQS. "" THEN - + installman3dir ="''vms_prefix':[man.man3]" +$ IF F$TYPE(installprivlib) .EQS. "" THEN - + installprivlib ="''vms_prefix':[lib]" +$ IF F$TYPE(installsitearch) .EQS. "" THEN - + installsitearch="''vms_prefix':[lib.site_perl.''archname']" +$ IF F$TYPE(installsitelib) .EQS. "" THEN - + installsitelib ="''vms_prefix':[lib.site_perl]" +$ IF F$TYPE(oldarchlib) .EQS. "" THEN - + oldarchlib="''vms_prefix':[lib.''archname']" +$ IF F$TYPE(oldarchlibexp) .EQS. "" THEN - + oldarchlibexp="''vms_prefix':[lib.''archname']" +$ IF F$TYPE(privlibexp) .EQS. "" THEN - + privlibexp ="''vms_prefix':[lib]" +$ IF F$TYPE(sitearchexp) .EQS. "" THEN - + sitearchexp ="''vms_prefix':[lib.site_perl.''archname']" +$ IF F$TYPE(sitelib_stem) .EQS. "" THEN - + sitelib_stem ="''vms_prefix':[lib.site_perl]" +$ IF F$TYPE(sitelibexp) .EQS. "" THEN - + sitelibexp ="''vms_prefix':[lib.site_perl]" +$! $!: see if we need a special compiler $! cc_list = "cc/decc|gcc" !%Config-I-VMS, compiler symbols/commands $! @@ -1209,7 +1420,9 @@ $ vms_cc_dflt = "" $ vms_cc_available = "" $! $ OPEN/WRITE CONFIG ccvms.c +$ WRITE CONFIG "#ifdef __DECC" $ WRITE CONFIG "#include " !DECC is sooo picky +$ WRITE CONFIG "#endif" $ WRITE CONFIG "#include " $ WRITE CONFIG "int main() {" $ WRITE CONFIG "#ifdef __DECC" @@ -1228,8 +1441,6 @@ $ tmp = $status $! DEASSIGN SYS$OUTPUT $! DEASSIGN SYS$ERROR $ IF (silent) THEN GOSUB Shut_up -$! echo "%Config-I-VMS, After cc compile $status = >''tmp'<" !diagnostic -$! $ IF tmp.NE.%X10B90001 $ THEN $ IF tmp.NE.%X10000001 @@ -1241,28 +1452,26 @@ $ ENDIF $! $ GOSUB List_Parse $ IF .NOT.silent THEN echo "" -$ echo "%Config-I-VMS, Default ""cc"" is ''line' ''archsufx' ''F$GETSYI("VERSION")'" +$ echo "Default ""cc"" is ''line' ''archsufx' ''F$GETSYI("VERSION")'" $ IF F$LOCATE("VAX",line).NE.F$LENGTH(line) $ THEN $ IF .NOT.silent $ THEN -$ echo "%Config-I-VMS, Will try cc/decc..." +$ echo "Will try cc/decc..." $ ENDIF -$ DEFINE SYS$ERROR _NLA0: -$ DEFINE SYS$OUTPUT _NLA0: +$ DEFINE/USER_MODE SYS$ERROR NL: +$ DEFINE/USER_MODE SYS$OUTPUT NL: $ SET NOON $ cc/decc/NoObj/list=ccvms.lis ccvms.c $ tmp = $status -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR $ SET ON $ IF (silent) THEN GOSUB Shut_up $ IF tmp.NE.%X10B90001 $ THEN -$ echo "%Config-I-VMS, Apparently you don't have that one." +$ echo "Apparently you don't have that one." $ ELSE $ GOSUB List_parse -$ echo "%Config-I-VMS, You also have: ''line' ''archsufx' ''F$GETSYI("VERSION")'" +$ echo "You also have: ''line' ''archsufx' ''F$GETSYI("VERSION")'" $ vms_cc_available = vms_cc_available + "cc/decc " $ ENDIF $ ELSE @@ -1274,20 +1483,19 @@ $ ENDIF $ ENDIF $! $Gcc_initial_check: -$ echo "%Config-I-VMS, Checking for Gcc" +$ echo "Checking for gcc" $ OPEN/WRITE CONFIG gccvers.lis -$ DEFINE SYS$ERROR CONFIG -$ DEFINE SYS$OUTPUT CONFIG +$ DEFINE/USER_MODE SYS$ERROR CONFIG +$ DEFINE/USER_MODE SYS$OUTPUT CONFIG $ 'gcc_symbol'/noobj/version _nla0: $ tmp = $status -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR $ IF (silent) THEN GOSUB Shut_up $ CLOSE CONFIG $ IF (tmp.NE.%X10000001).and.(tmp.ne.%X00030001) $ THEN -$ echo "%Config-I-VMS, Symbol ""''gcc_symbol'"" is not defined. I guess you don't have it." -$ goto cc_cleanup +$ echo "Symbol ""''gcc_symbol'"" is not defined. I guess you do not have it." +$ DELETE/NOLOG/NOCONFIRM gccvers.lis; +$ GOTO Cxx_initial_check $ ENDIF $ OPEN/READ CONFIG gccvers.lis $GCC_List_Read: @@ -1299,12 +1507,93 @@ $ echo line $ vms_cc_available = vms_cc_available + "''gcc_symbol' " $ DELETE/NOLOG/NOCONFIRM gccvers.lis; $! +$Cxx_initial_check: +$! +$! Do note that [vms]perl source files have a ways to go before they will +$! compile under CXX. +$! In order to test Configure.com with CXX invoke it with "-Dtry_cxx" on +$! the command line. +$! +$ IF F$TYPE(try_cxx) .EQS. "" THEN try_cxx := n +$ IF try_cxx .OR. try_cxx .EQS. "define" +$! +$ THEN +$! +$ echo "Checking for CXX..." +$ OPEN/WRITE CONFIG ccvms.c +$ WRITE CONFIG "#include " +$ WRITE CONFIG "int main() {" +$ WRITE CONFIG "#ifdef __DECCXX" +$ WRITE CONFIG " cout << __DECCXX, endl;" +$ WRITE CONFIG "#else" +$ WRITE CONFIG " cout << 0,endl;" +$ WRITE CONFIG "#endif" +$! Todo: add G++ identifier check ?? +$ WRITE CONFIG " return(0);" +$ WRITE CONFIG "}" +$ CLOSE CONFIG +$ SET NOON +$ DEFINE/USER_MODE SYS$OUTPUT NL: +$ DEFINE/USER_MODE SYS$ERROR NL: +$ cxx ccvms.c +$ tmp = $status +$ SET ON +$! success $status with: +$! DEC C++ V1.1-001 on VMS VAX V5.5-2 +$! DEC C++ V5.6-013 on OpenVMS VAX V7.1 +$! DEC C++ V6.1-003 on OpenVMS Alpha V7.1 +$! Compaq C++ V6.2-016 for OpenVMS Alpha V7.2-1 +$ IF tmp .eq. %X15F60001 +$ THEN +$! Which linker? +$ SET NOON +$ DEFINE/USER_MODE SYS$OUTPUT NL: +$ DEFINE/USER_MODE SYS$ERROR NL: +$ link ccvms.obj +$ tmp = $status +$ SET ON +$ ! success $status with: +$ ! link && DEC C++ V1.1-001 on VMS VAX V5.5-2 +$ ! link && DEC C++ V5.6-013 on OpenVMS VAX V7.1 +$ IF tmp .eq. %X10000001 +$ THEN +$ ld_try = "Link" +$ vms_cc_available = vms_cc_available + "cxx " +$ echo "CXX and LINK are available." +$ ELSE +$ IF F$SEARCH("ccvms.exe") .NES. "" THEN DELETE/NOLOG/NOCONFIRM ccvms.exe; +$ SET NOON +$ DEFINE/USER_MODE SYS$OUTPUT NL: +$ DEFINE/USER_MODE SYS$ERROR NL: +$ cxxlink ccvms.obj +$ tmp = $status +$ SET ON +$ ! success $status with: +$ ! cxxlink && DEC C++ V6.1-003 on OpenVMS Alpha V7.1 +$ ! cxxlink && Compaq C++ V6.2-016 for OpenVMS Alpha V7.2-1 +$ IF tmp .eq. %X10000001 +$ THEN +$ ld_try = "cxxlink" +$ vms_cc_available = vms_cc_available + "cxx " +$ echo "CXX and CXXLINK are available." +$ ENDIF +$ ENDIF +$ IF F$SEARCH("ccvms.exe") .NES. "" THEN DELETE/NOLOG/NOCONFIRM ccvms.exe; +$ ELSE +$ echo "Nope." +$ ENDIF +$ DELETE/NOLOG/NOCONFIRM ccvms.c; +$ IF F$SEARCH("ccvms.obj") .NES. "" THEN DELETE/NOLOG/NOCONFIRM ccvms.obj; +$ CALL Cxx_demangler_cleanup +$! +$ ENDIF ! 1 .eq. 0 or 1 .eq. 1 +$! $CC_Cleanup: $ DELETE/NOLOG/NOCONFIRM ccvms.*; $CC_Desired: $!: see if we need a special compiler $! echo "" -$ echo "%Config-I-VMS, available compiler(s):" +$ echo "Available compiler(s):" $ echo "( ''vms_cc_available')" $ IF .NOT.nocc $ THEN @@ -1321,42 +1610,53 @@ $ Mcc = ans $ IF (F$LOCATE("dec",ans).NE.F$LENGTH(ans)).or.(F$LOCATE("compaq",ans).NE.F$LENGTH(ans)) $ THEN $ Mcc = "cc/decc" -$ Using_Dec_C = "Yes" +$! CPQ ? +$ ccname := DEC $ C_COMPILER_Replace = "CC=cc=''Mcc'" $ ENDIF -$ IF Mcc.NES.dflt +$ IF F$LOCATE("cxx",F$EDIT(ans,"COLLAPSE,LOWERCASE")) .NE. F$LENGTH(ans) $ THEN -$ IF (F$LOCATE("dec",dflt).NE.F$LENGTH(dflt)).or(F$LOCATE("compaq",dflt).NE.F$LENGTH(dflt)) -$ THEN -$ C_COMPILER_Replace = "CC=cc=''Mcc'" -$ ELSE -$ Using_Dec_C = "Yes" -$ ENDIF -$ ELSE -$ IF Mcc .EQS. "cc/decc" +$ Mcc = "cxx" +$ ccname := CXX +$ ld = ld_try +$ C_COMPILER_Replace = "CC=cc=''Mcc'" +$ ELSE ! Not_cxx +$ IF Mcc.NES.dflt $ THEN -$ Using_Dec_C = "Yes" -$ C_COMPILER_Replace = "CC=cc=''Mcc'" +$ IF F$LOCATE("dec",dflt) .NE. F$LENGTH(dflt) .or. - + F$LOCATE("compaq",dflt) .NE. F$LENGTH(dflt) +$ THEN +$ C_COMPILER_Replace = "CC=cc=''Mcc'" +$ ELSE +$ ccname := DEC +$ ENDIF +$ ELSE +$ IF Mcc .EQS. "cc/decc" +$ THEN +$ ccname := DEC +$ C_COMPILER_Replace = "CC=cc=''Mcc'" +$ ENDIF $ ENDIF $ ENDIF $ ELSE $ Mcc = dflt $ IF Mcc .EQS. "cc/decc" $ THEN -$ Using_Dec_C = "Yes" +$ ccname := DEC $ C_COMPILER_Replace = "CC=cc=''Mcc'" $ ENDIF $ IF Mcc .EQS. "gcc" $ THEN -$ Using_Gnu_C = "Yes" +$ ccname := GCC $ C_COMPILER_Replace = "CC=cc=''Mcc'" $ ENDIF $ ENDIF $Decc_Version_check: -$ IF "''Using_Dec_C'".EQS."Yes" +$ ccversion="" +$ IF ccname .EQS. "DEC" $ THEN $ echo "" -$ echo4 "Checking for Dec C's version number..." !>&4 +$ echo4 "Checking for the Dec C version number..." $ OPEN/WRITE CONFIG deccvers.c $ WRITE CONFIG "#include " !DECC is sooo picky $ WRITE CONFIG "#include " @@ -1371,153 +1671,219 @@ $ WRITE CONFIG "#endif" $ WRITE CONFIG " exit(0);" $ WRITE CONFIG "}" $ CLOSE CONFIG -$ DEFINE SYS$ERROR _NLA0: -$ DEFINE SYS$OUTPUT _NLA0: +$ SET NOON +$ DEFINE/USER_MODE SYS$ERROR NL: +$ DEFINE/USER_MODE SYS$OUTPUT NL: $ 'Mcc' deccvers.c $ tmp = $status -$ DEASSIGN SYS$ERROR _NLA0: -$ DEASSIGN SYS$OUTPUT _NLA0: $ IF (silent) THEN GOSUB Shut_up -$ DEFINE SYS$ERROR _NLA0: -$ DEFINE SYS$OUTPUT _NLA0: +$ DEFINE/USER_MODE SYS$ERROR NL: +$ DEFINE/USER_MODE SYS$OUTPUT NL: $ link deccvers.obj $ tmp = $status -$ DEASSIGN SYS$ERROR -$ DEASSIGN SYS$OUTPUT $ IF (silent) THEN GOSUB Shut_up $ OPEN/WRITE CONFIG deccvers.out -$ DEFINE SYS$ERROR CONFIG -$ DEFINE SYS$OUTPUT CONFIG +$ DEFINE/USER_MODE SYS$ERROR CONFIG +$ DEFINE/USER_MODE SYS$OUTPUT CONFIG $ mcr []deccvers.exe $ tmp = $status +$ SET ON $ CLOSE CONFIG -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR $ IF (silent) THEN GOSUB Shut_up $ OPEN/READ CONFIG deccvers.out $ READ/END_OF_FILE=Dec_c_cleanup CONFIG line $Dec_c_cleanup: $ CLOSE CONFIG -$! DELETE/NOLOG/NOCONFIRM deccvers.*; $ echo "You are using Dec C ''line'" -$ Dec_C_Version = line -$ Dec_C_Version = Dec_C_Version + 0 -$ if Dec_C_Version.ge.60200000 THEN CC_FLAGS = CC_FLAGS + "/NOANSI_ALIAS" +$ ccversion = line +$ Dec_C_Version = F$INTEGER(line) +$ IF Dec_C_Version .GE. 60200000 +$ THEN +$ echo4 "adding /NOANSI_ALIAS qualifier to ccflags." +$ ccflags = ccflags + "/NOANSI_ALIAS" +$ ENDIF +$ DELETE/NOLOG/NOCONFIRM deccvers.*; $ ENDIF $Gcc_check: -$ if "''using_gnu_c'" .eqs. "Yes" +$ gccversion = "" +$ IF ccname .EQS. "GCC" $ THEN -$ vaxcrtl_olb = F$SEARCH("SYS$LIBRARY:VAXCRTL.OLB") -$ vaxcrtl_exe = F$SEARCH("SYS$SHARE:VAXCRTL.EXE") -$ gcclib_olb = F$SEARCH("GNU_CC:[000000]GCCLIB.OLB") -$ IF gcclib_olb .EQS. "" -$ THEN -$! These objects/libs come w/ gcc 2.7.2 for AXP: -$ tmp = F$SEARCH("GNU_CC:[000000]libgcc2.olb") -$ IF tmp .NES. "" then gcclib_olb = tmp -$ tmp = F$SEARCH("GNU_CC:[000000]libgcclib.olb") -$ IF tmp .NES. "" +$ vaxcrtl_olb = F$SEARCH("SYS$LIBRARY:VAXCRTL.OLB") +$ vaxcrtl_exe = F$SEARCH("SYS$SHARE:VAXCRTL.EXE") +$ gcclib_olb = F$SEARCH("GNU_CC:[000000]GCCLIB.OLB") +$ IF gcclib_olb .EQS. "" $ THEN -$ IF gcclib_olb .EQS. "" -$ THEN gcclib_olb = tmp -$ ELSE gcclib_olb = gcclib_olb + "/lib," + tmp +$! These objects/libs come w/ gcc 2.7.2 for AXP: +$ tmp = F$SEARCH("GNU_CC:[000000]libgcc2.olb") +$ IF tmp .NES. "" then gcclib_olb = tmp +$ tmp = F$SEARCH("GNU_CC:[000000]libgcclib.olb") +$ IF tmp .NES. "" +$ THEN +$ IF gcclib_olb .EQS. "" +$ THEN gcclib_olb = tmp +$ ELSE gcclib_olb = gcclib_olb + "/lib," + tmp +$ ENDIF $ ENDIF -$ ENDIF -$ tmp = F$SEARCH("SYS$LIBRARY:VAXCRTL.OLB") -$ IF tmp .NES. "" -$ THEN -$ IF gcclib_olb .EQS. "" -$ THEN gcclib_olb = tmp -$ ELSE gcclib_olb = gcclib_olb + "/lib," + tmp +$ tmp = F$SEARCH("SYS$LIBRARY:VAXCRTL.OLB") +$ IF tmp .NES. "" +$ THEN +$ IF gcclib_olb .EQS. "" +$ THEN gcclib_olb = tmp +$ ELSE gcclib_olb = gcclib_olb + "/lib," + tmp +$ ENDIF $ ENDIF -$ ENDIF -$ tmp = F$SEARCH("GNU_CC:[000000]crt0.obj") -$ IF tmp .NES. "" -$ THEN -$ IF gcclib_olb .EQS. "" -$ THEN gcclib_olb = tmp -$ ELSE gcclib_olb = gcclib_olb + "/lib," + tmp +$ tmp = F$SEARCH("GNU_CC:[000000]crt0.obj") +$ IF tmp .NES. "" +$ THEN +$ IF gcclib_olb .EQS. "" +$ THEN gcclib_olb = tmp +$ ELSE gcclib_olb = gcclib_olb + "/lib," + tmp +$ ENDIF $ ENDIF +$ IF gcclib_olb .EQS. vaxcrtl_olb THEN gcclib_olb = "" !goofy order of axplibs +$ ELSE +$ gcclib_olb = gcclib_olb + "/lib" $ ENDIF -$ IF gcclib_olb .EQS. vaxcrtl_olb THEN gcclib_olb = "" !goofy order of axplibs -$ ELSE -$ gcclib_olb = gcclib_olb + "/lib" -$ ENDIF -$ IF gcclib_olb .NES. "" .AND. - +$ IF gcclib_olb .NES. "" .AND. - (vaxcrtl_olb .NES. "" .OR. - vaxcrtl_exe .NES. "" ) -$ THEN -$ echo "" -$ echo4 "Checking for GNU cc in disguise and/or its version number..." !>&4 -$ OPEN/WRITE CONFIG gccvers.c -$ WRITE CONFIG "#include " !DECC is sooo picky -$ WRITE CONFIG "#include " -$ WRITE CONFIG "int main() {" -$ WRITE CONFIG "#ifdef __GNUC__" -$ WRITE CONFIG "#ifdef __VERSION__" -$ WRITE CONFIG " printf(""%s\n"", __VERSION__);" -$ WRITE CONFIG "#else" -$ WRITE CONFIG " printf(""%s\n"", ""1"");" -$ WRITE CONFIG "#endif" -$ WRITE CONFIG "#endif" -$ WRITE CONFIG " exit(0);" -$ WRITE CONFIG "}" -$ CLOSE CONFIG -$ DEFINE SYS$ERROR _NLA0: -$ DEFINE SYS$OUTPUT _NLA0: -$ 'Mcc' gccvers.c -$ tmp = $status -$ DEASSIGN SYS$ERROR _NLA0: -$ DEASSIGN SYS$OUTPUT _NLA0: -$ IF (silent) THEN GOSUB Shut_up -$ DEFINE SYS$ERROR _NLA0: -$ DEFINE SYS$OUTPUT _NLA0: -$ IF vaxcrtl_exe .EQS. "" -$ THEN -$ IF F$LOCATE("VAXCRTL",gcclib_olb).NE.F$LENGTH(gcclib_olb) +$ THEN +$ echo "" +$ echo4 "Checking for GNU cc in disguise and/or its version number..." !>&4 +$ OPEN/WRITE CONFIG gccvers.c +$ WRITE CONFIG "#include " +$ WRITE CONFIG "int main() {" +$ WRITE CONFIG "#ifdef __GNUC__" +$ WRITE CONFIG "#ifdef __VERSION__" +$ WRITE CONFIG " printf(""%s\n"", __VERSION__);" +$ WRITE CONFIG "#else" +$ WRITE CONFIG " printf(""%s\n"", ""1"");" +$ WRITE CONFIG "#endif" +$ WRITE CONFIG "#endif" +$ WRITE CONFIG " exit(0);" +$ WRITE CONFIG "}" +$ CLOSE CONFIG +$ DEFINE SYS$ERROR _NLA0: +$ DEFINE SYS$OUTPUT _NLA0: +$ 'Mcc' gccvers.c +$ tmp = $status +$ DEASSIGN SYS$ERROR _NLA0: +$ DEASSIGN SYS$OUTPUT _NLA0: +$ IF (silent) THEN GOSUB Shut_up +$ DEFINE SYS$ERROR _NLA0: +$ DEFINE SYS$OUTPUT _NLA0: +$ IF vaxcrtl_exe .EQS. "" $ THEN -$ link gccvers.obj,'gcclib_olb',SYS$LIBRARY:VAXCRTL/Library -$ tmp = $status +$ IF F$LOCATE("VAXCRTL",gcclib_olb).NE.F$LENGTH(gcclib_olb) +$ THEN +$ link gccvers.obj,'gcclib_olb',SYS$LIBRARY:VAXCRTL/Library +$ tmp = $status +$ ELSE +$ link gccvers.obj,'gcclib_olb' +$ tmp = $status +$ ENDIF $ ELSE -$ link gccvers.obj,'gcclib_olb' +$ OPEN/WRITE CONFIG GCCVERS.OPT +$ WRITE CONFIG "SYS$SHARE:VAXCRTL/SHARE" +$ CLOSE CONFIG +$ link gccvers.obj,GCCVERS.OPT/OPT,'gcclib_olb' $ tmp = $status $ ENDIF -$ ELSE -$ OPEN/WRITE CONFIG GCCVERS.OPT -$ WRITE CONFIG "SYS$SHARE:VAXCRTL/SHARE" -$ CLOSE CONFIG -$ link gccvers.obj,GCCVERS.OPT/OPT,'gcclib_olb' +$ DEASSIGN SYS$ERROR +$ DEASSIGN SYS$OUTPUT +$ IF (silent) THEN GOSUB Shut_up +$ OPEN/WRITE CONFIG gccvers.out +$ DEFINE SYS$ERROR CONFIG +$ DEFINE SYS$OUTPUT CONFIG +$ mcr []gccvers.exe $ tmp = $status -$ ENDIF -$ DEASSIGN SYS$ERROR -$ DEASSIGN SYS$OUTPUT -$ IF (silent) THEN GOSUB Shut_up -$ OPEN/WRITE CONFIG gccvers.out -$ DEFINE SYS$ERROR CONFIG -$ DEFINE SYS$OUTPUT CONFIG -$ mcr []gccvers.exe -$ tmp = $status -$ CLOSE CONFIG -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ IF (silent) THEN GOSUB Shut_up -$ OPEN/READ CONFIG gccvers.out -$ READ/END_OF_FILE=Gcc_cleanup CONFIG line +$ CLOSE CONFIG +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ IF (silent) THEN GOSUB Shut_up +$ OPEN/READ CONFIG gccvers.out +$ READ/END_OF_FILE=Gcc_cleanup CONFIG line $Gcc_cleanup: -$ CLOSE CONFIG -$ DELETE/NOLOG/NOCONFIRM gccvers.*; -$ IF F$LOCATE("GNU C version ",line).NE.F$LENGTH(line) -$ THEN -$ echo "You are not using GNU cc." -$ GOTO Host_name -$ ELSE -$ echo "You are using GNU cc ''line'" -$ Using_Gnu_C = "Yes" -$ C_COMPILER_Replace = "CC=cc=''Mcc'" -$ GOTO Include_dirs +$ CLOSE CONFIG +$ DELETE/NOLOG/NOCONFIRM gccvers.*; +$ IF F$LOCATE("GNU C version ",line).NE.F$LENGTH(line) +$ THEN +$ echo "You are not using GNU cc." +$ GOTO Host_name +$ ELSE +$ echo "You are using GNU cc ''line'" +$ gccversion = line +$ ccname := "GCC" +$ C_COMPILER_Replace = "CC=cc=''Mcc'" +$ GOTO Include_dirs +$ ENDIF $ ENDIF $ ENDIF -$endif +$Cxx_Version_check: +$ IF ccname .EQS. "CXX" +$ THEN +$ OPEN/WRITE CONFIG cxxvers.c +$ WRITE CONFIG "#include " +$ WRITE CONFIG "int main() {" +$ WRITE CONFIG "#ifdef __DECCXX_VER" +$ WRITE CONFIG " printf(""%i\n"", __DECCXX_VER);" +$ WRITE CONFIG "#else" +$ WRITE CONFIG " printf(""%i\n"", ""0"");" +$ WRITE CONFIG "#endif" +$ WRITE CONFIG " return(0);" +$ WRITE CONFIG "}" +$ CLOSE CONFIG +$ SET NOON +$ DEFINE/USER_MODE SYS$ERROR NL: +$ DEFINE/USER_MODE SYS$OUTPUT NL: +$ 'Mcc' cxxvers.c +$ tmp = $status +$ SET ON +$ IF (silent) THEN GOSUB Shut_up +$ SET NOON +$ DEFINE/USER_MODE SYS$ERROR NL: +$ DEFINE/USER_MODE SYS$OUTPUT NL: +$ 'ld' cxxvers.obj +$ tmp = $status +$ SET ON +$ IF (silent) THEN GOSUB Shut_up +$ OPEN/WRITE CONFIG cxxvers.out +$ SET NOON +$ DEFINE/USER_MODE SYS$ERROR CONFIG +$ DEFINE/USER_MODE SYS$OUTPUT CONFIG +$ mcr []cxxvers.exe +$ tmp = $status +$ SET ON +$ CLOSE CONFIG +$ IF (silent) THEN GOSUB Shut_up +$ OPEN/READ CONFIG cxxvers.out +$ READ/END_OF_FILE=Cxx_cleanup CONFIG line +$Cxx_cleanup: +$ CLOSE CONFIG +$ DELETE/NOLOG/NOCONFIRM cxxvers.*; +$ echo "You are using CXX ''line'" +$ cxxversion = line +$ ccversion = line +$ CALL Cxx_demangler_cleanup +$ ENDIF +$! +$Cxx_demangler_cleanup: SUBROUTINE +$! +$! If we do build with CXX these demangler Dbs will be left all over. +$! However, configure.com does try to remove the [.UU] sub directory. +$! Be sure to set default to the correct place before calling this sub. +$! +$ SET NOON +$ IF F$SEARCH("[.CXX_REPOSITORY]*.*") .NES. "" THEN DELETE/NOLOG/NOCONFIRM [.CXX_REPOSITORY]*.*;* +$ IF F$SEARCH("CXX_REPOSITORY.DIR") .NES. "" +$ THEN +$ SET PROTECTION=(SYSTEM:RWED,OWNER:RWED) CXX_REPOSITORY.DIR +$ DELETE/NOLOG/NOCONFIRM CXX_REPOSITORY.DIR; +$ ENDIF +$ SET ON +$ EXIT +$ ENDSUBROUTINE ! Cxx_demangler_cleanup +$! $ GOTO Host_name $! $List_Parse: @@ -1542,7 +1908,7 @@ $ DELETE/NOLOG/NOCONFIRM ccvms.lis; $ RETURN $! $Include_dirs: -$!: What should the include directory be ? +$!: What should the include directory be ? (.TLB text libraries) $ dflt = gcclib_olb $ rp = "Where are the include files you want to use? " $ IF f$length( rp + "[''dflt'] " ).gt.76 @@ -1608,30 +1974,39 @@ $ ENDIF $ myhostname = myhostname - mydomain $ echo "(Trimming domain name from host name--host name is now ''myhostname')" $ IF .NOT.silent -$ THEN TYPE SYS$INPUT: +$ THEN +$ TYPE SYS$INPUT: +$ DECK I need to get your e-mail address in Internet format if possible, i.e. something like user@host.domain. Please answer accurately since I have no easy means to double check it. The default value provided below is most probably close to the reality but may not be valid from outside your organization... +$ EOD $ ENDIF -$ dflt = "''cf_by'@''myhostname'"+"''mydomain'" -$ rp = "What is your e-mail address? [''dflt'] " -$ GOSUB myread -$ IF ans .nes. "" -$ THEN cf_email = ans -$ ELSE cf_email = dflt +$ IF F$TYPE(cf_email) .EQS. "" +$ THEN +$ dflt = "''cf_by'@''myhostname'"+"''mydomain'" +$ rp = "What is your e-mail address? [''dflt'] " +$ GOSUB myread +$ IF ans .nes. "" +$ THEN cf_email = ans +$ ELSE cf_email = dflt +$ ENDIF $ ENDIF $! $ IF .NOT.silent -$ THEN TYPE SYS$INPUT: +$ THEN +$ TYPE SYS$INPUT: +$ DECK If you or somebody else will be maintaining perl at your site, please fill in the correct e-mail address here so that they may be contacted if necessary. Currently, the "perlbug" program included with perl will send mail to this address in addition to perlbug@perl.com. You may enter "none" for no administrator. +$ EOD $ ENDIF $ dflt = "''cf_email'" $ rp = "Perl administrator e-mail address [''dflt'] " @@ -1667,40 +2042,49 @@ $!: see if we have sigaction $!: see whether socketshr exists $ IF (F$SEARCH(F$PARSE("SocketShr","Sys$Share:.Exe")).NES."") $ THEN -$ has_socketshr = "T" +$ Has_socketshr = "T" $ echo "" -$ echo4 "Hmm... Looks like you have SOCKETSHR's Berkeley networking support." -$ endif -$ if (Dec_C_Version .ge. 50200000) +$ echo4 "Hmm... Looks like you have SOCKETSHR Berkeley networking support." +$ ELSE +$ Has_socketshr = "F" +$ ENDIF +$ IF (ccname .EQS. "DEC" .AND. Dec_C_Version .GE. 50200000) .OR. - + (ccname .EQS. "CXX") $ THEN $ Has_Dec_C_Sockets = "T" $ echo "" -$ echo4 "Hmm... Looks like you've got Dec C's Berkeley networking support." +$ echo4 "Hmm... Looks like you have Dec C Berkeley networking support." +$ ELSE +$ Has_Dec_C_Sockets = "F" $ ENDIF $ ! Hey, we've got both. Default to Dec C, then, since it's better -$ if ("''Has_socketshr'".eq."T") .or.("''has_dec_c_sockets'".eq."T") +$ IF Has_socketshr .OR. Has_Dec_C_Sockets $ THEN $ echo "" -$ echo "You've got sockets available. Which socket stack do you want to" -$ echo "build into perl?" -$ if "''has_dec_c_sockets'".eqs."T" +$ echo "You have sockets available. Which socket stack do you want to" +$ echo "build into Perl?" +$ IF Has_Dec_C_Sockets $ THEN $ dflt = "DECC" $ else $ dflt = "SOCKETSHR" $ endif $ rp = "Choose socket stack (NONE" -$ if "''has_socketshr'".eqs."T" THEN rp = rp + ",SOCKETSHR" -$ if "''has_dec_c_sockets'".eqs."T" THEN rp = rp + ",DECC" +$ IF Has_socketshr THEN rp = rp + ",SOCKETSHR" +$ IF Has_Dec_C_Sockets THEN rp = rp + ",DECC" $ rp = rp + ") [''dflt'] " $ GOSUB myread -$ IF "''ans'".eqs."" THEN ans = "''dflt'" -$ has_dec_c_sockets = "F" -$ has_socketshr = "F" +$ IF ans .EQS. "" THEN ans = "''dflt'" +$ Has_Dec_C_Sockets = "F" +$ Has_socketshr = "F" $ ans = F$EDIT(ans,"TRIM,COMPRESS,LOWERCASE") -$ IF ans.eqs."decc" then has_dec_c_sockets = "T" -$ IF ans.eqs."socketshr" then has_socketshr = "T" -$ endif +$ IF ans.eqs."decc" then Has_Dec_C_Sockets = "T" +$ IF ans.eqs."socketshr" then Has_socketshr = "T" +$ ENDIF +$ IF Has_Dec_C_Sockets .or. Has_socketshr +$ THEN +$ static_ext = f$edit(static_ext+" "+"Socket","trim,compress") +$ ENDIF $! $! $! Ask if they want to build with VMS_DEBUG perl @@ -1723,11 +2107,11 @@ $ ENDIF $! $! Ask if they want to build with DEBUGGING $ echo "" -$ echo "Perl can be built with extra runtime debugging enabled. This -$ echo "enables the -D switch, at the cost of some performance. It -$ echo "was mandatory on perl 5.005 and before on VMS, but is now -$ echo "optional. If you don't generally use it you should probably -$ echo "leave this off and gain a bit of extra speed. +$ echo "Perl can be built with extra runtime debugging enabled. This" +$ echo "enables the -D switch, at the cost of some performance. It" +$ echo "was mandatory on perl 5.005 and before on VMS, but is now" +$ echo "optional. If you do not generally use it you should probably" +$ echo "leave this off and gain a bit of extra speed." $ dflt = "y" $ rp = "Build a DEBUGGING version of Perl? [''dflt'] " $ GOSUB myread @@ -1741,77 +2125,72 @@ $ ENDIF $! $! Ask if they want to build with MULTIPLICITY $ echo "" -$ echo "The perl interpreter engine can be built in a way that makes it -$ echo "possible for a program that embeds perl into it (and yes, you can -$ echo "do that--it's pretty keen) to have multiple perl interpreters active -$ echo "at once. There is some performance overhead, however, so you -$ echo "probably don't want to choose this unless you're going to be doing -$ echo "funky perl embedding." +$ echo "Perl can be built so that multiple Perl interpreters can coexist" +$ echo "within the same Perl executable." +$ echo "There is some performance overhead, however, so you" +$ echo "probably do not want to choose this unless you are going to be" +$ echo "doing things with embedded perl." $ dflt = "n" -$ rp = "Build with MULTIPLICITY? [''dflt'] " +$ rp = "Build Perl for multiplicity? [''dflt'] " $ GOSUB myread -$ if ans.eqs."" then ans = dflt -$ IF F$EXTRACT(0, 1, F$EDIT(ans,"COLLAPSE,UPCASE")) .eqs. "Y" +$ IF ans.eqs."" then ans = dflt +$ IF ans $ THEN -$ use_multiplicity="Y" +$ usemultiplicity="define" $ ELSE -$ use_multiplicity="N" +$ usemultiplicity="undef" $ ENDIF $! $! Ask if they want to build with 64-bit support -$ IF (Archname.eqs."VMS_AXP").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1") +$ IF (archname.eqs."VMS_AXP").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1") $ THEN $ dflt = use64bitint $ echo "" -$ echo "You can have native 64-bit long integers. +$ echo "You can have native 64-bit long integers." $ echo "" -$ echo "Perl can be built to take advantage of 64-bit integer types -$ echo "on some systems, which provide a much larger range for perl's -$ echo "mathematical operations. (Note that does *not* enable 64-bit +$ echo "Perl can be built to take advantage of 64-bit integer types" +$ echo "on some systems, which provide a much larger range for perl's" +$ echo "mathematical operations. (Note that does *not* enable 64-bit" $ echo "fileops at the moment, as Dec C doesn't do that yet)." -$ echo "Choosing this option will most probably introduce binary incompatibilities. +$ echo "Choosing this option will most probably introduce binary incompatibilities." $ echo "" -$ echo "If this doesn't make any sense to you, just accept the default ''dflt'. +$ echo "If this does not make any sense to you, just accept the default ''dflt'." $ rp = "Try to use 64-bit integers, if available? [''dflt'] " $ GOSUB myread $ IF ans .EQS. "" THEN ans = dflt -$ IF (f$extract(0, 1, f$edit(ans,"COLLAPSE,UPCASE")) .EQS. "Y") -$ THEN -$ use64bitint="Y" -$ ELSE -$ use64bitint="N" +$ IF ans +$ THEN use64bitint="Y" +$ ELSE use64bitint="N" $ ENDIF $ IF (use64bitint) $ THEN $ dflt = use64bitall $ echo "" -$ echo "Since you chose 64-bitness you may want to try maximal 64-bitness. -$ echo "What you have chosen is minimal 64-bitness which means just enough -$ echo "to get 64-bit integers. The maximal means using as much 64-bitness -$ echo "as is possible on the platform. This in turn means even more binary -$ echo "incompatibilities. On the other hand, your platform may not have -$ echo "any more maximal 64-bitness than what you already have chosen. +$ echo "Since you chose 64-bitness you may want to try maximal 64-bitness." +$ echo "What you have chosen is minimal 64-bitness which means just enough" +$ echo "to get 64-bit integers. The maximal means using as much 64-bitness" +$ echo "as is possible on the platform. This in turn means even more binary" +$ echo "incompatibilities. On the other hand, your platform may not have" +$ echo "any more maximal 64-bitness than what you already have chosen." $ echo "" -$ echo "If this doesn't make any sense to you, just accept the default ''dflt'. +$ echo "If this does not make any sense to you, just accept the default ''dflt'." $ rp = "Try to use full 64-bit support, if available? [''dflt'] " $ GOSUB myread $ IF ans .EQS. "" THEN ans = dflt -$ IF (f$extract(0, 1, f$edit(ans,"COLLAPSE,UPCASE")) .EQS. "Y") -$ THEN -$ use64bitall="Y" -$ ELSE -$ use64bitall="N" +$ IF ans +$ THEN use64bitall="Y" +$ ELSE use64bitall="N" $ ENDIF $ ENDIF $ ENDIF ! AXP && >= 7.1 $! $! Ask about threads, if appropriate -$ if (Using_Dec_C.eqs."Yes") +$ IF ccname .EQS. "DEC" .OR. ccname .EQS. "CXX" $ THEN $ echo "" -$ echo "This version of Perl can be built with threads. While really nifty, -$ echo "they are a beta feature, and there is a speed penalty for perl -$ echo "programs if you build with threads *even if you don't use them* +$ echo "This version of Perl can be built with threads. While really nifty," +$ echo "they are a beta feature, and there is a speed penalty for perl" +$ echo "programs if you build with threads *even if you do not use them*." $ dflt = "n" $ rp = "Build with threads? [''dflt'] " $ GOSUB myread @@ -1819,22 +2198,21 @@ $ if ans.eqs."" then ans = dflt $ if (f$extract(0, 1, "''ans'").eqs."Y").or.(f$extract(0, 1, "''ans'").eqs."y") $ THEN $ use_threads="T" -$! $ ! Shall we do the 5.005-stype threads, or IThreads? -$ echo "As of 5.5.640, Perl has two different internal threading -$ echo "implementations, the 5.005 version (5005threads) and an -$ echo "interpreter-based version (ithreads) that has one -$ echo "interpreter per thread. Both are very experimental. This -$ echo "arrangement exists to help developers work out which one -$ echo "is better. -$ echo " -$ echo "If you're a casual user, you probably don't want -$ echo "interpreter-threads at this time. There doesn't yet exist -$ echo "a way to create threads from within Perl in this model, -$ echo "i.e., ""use Thread;"" will NOT work. -$ echo " +$ echo "As of 5.5.640, Perl has two different internal threading" +$ echo "implementations, the 5.005 version (5005threads) and an" +$ echo "interpreter-based version (ithreads) that has one" +$ echo "interpreter per thread. Both are very experimental. This" +$ echo "arrangement exists to help developers work out which one" +$ echo "is better." +$ echo "" +$ echo "If you are a casual user, you probably do not want" +$ echo "interpreter-threads at this time. There doesn't yet exist" +$ echo "a way to create threads from within Perl in this model," +$ echo "i.e., ""use Thread;"" will NOT work." +$ echo "" $ dflt = "n" -$ rp = "Build with Interpreter threads? [''dflt'] +$ rp = "Build with Interpreter threads? [''dflt'] " $ GOSUB myread $ if ans.eqs."" then ans = dflt $ if (f$extract(0, 1, "''ans'").eqs."Y").or.(f$extract(0, 1, "''ans'").eqs."y") @@ -1846,17 +2224,17 @@ $ use_ithreads="N" $ use_5005_threads="Y" $ ENDIF $ ! Are they on VMS 7.1 on an alpha? -$ if (Archname.eqs."VMS_AXP").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1") +$ if (archname.eqs."VMS_AXP").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1") $ THEN $ echo "" -$ echo "Threaded perl can be linked to use multiple kernel threads -$ echo "and system upcalls on VMS 7.1+ on Alpha systems. This feature -$ echo "allows multiple threads to execute simultaneously on an SMP -$ echo "system as well as preventing a single thread from blocking -$ echo "all the threads in a program, even on a single-processor -$ echo "machine. Unfortunately this feature isn't safe on an -$ echo "unpatched 7.1 system. (Several OS patches were required when -$ echo "this procedure was written) +$ echo "Threaded perl can be linked to use multiple kernel threads" +$ echo "and system upcalls on VMS 7.1+ on Alpha systems. This feature" +$ echo "allows multiple threads to execute simultaneously on an SMP" +$ echo "system as well as preventing a single thread from blocking" +$ echo "all the threads in a program, even on a single-processor" +$ echo "machine. Unfortunately, this feature isn't safe on an" +$ echo "unpatched 7.1 system (several OS patches were required when" +$ echo "this procedure was written)." $ dflt = "n" $ rp = "Enable multiple kernel threads and upcalls? [''dflt'] " $ gosub myread @@ -1868,47 +2246,48 @@ $ ENDIF $ ENDIF $ ENDIF $ ENDIF -$ if archname .eqs. "VMS_AXP" -$ then -$! +$ IF archname .EQS. "VMS_AXP" +$ THEN $! Case sensitive? -$ echo "" -$ echo "By default, perl (and pretty much everything else on VMS) uses -$ echo "case-insensitive linker symbols. Which is to say, when the -$ echo "underlying C code makes a call to a routine called Perl_foo in -$ echo "the source, the name in the object modules or shareable images -$ echo "is really PERL_FOO. There are some packages that use an -$ echo "embedded perl interpreter that instead require case-sensitive -$ echo "linker symbols. -$ echo "" -$ echo "If you have no idea what this means, and don't have -$ echo "any program requiring anything, choose the default. -$ dflt = be_case_sensitive -$ rp = "Case-sensitive symbols [''dflt'] " -$ gosub myread -$ if ans.eqs."" then ans="''dflt'" -$ be_case_sensitive = "''ans'" -$! +$ echo "" +$ echo "By default, perl (and pretty much everything else on VMS) uses" +$ echo "case-insensitive linker symbols. Which is to say, when the" +$ echo "underlying C code makes a call to a routine called Perl_foo in" +$ echo "the source, the name in the object modules or shareable images" +$ echo "is really PERL_FOO. There are some packages that use an" +$ echo "embedded perl interpreter that instead require case-sensitive" +$ echo "linker symbols." +$ echo "" +$ echo "If you have no idea what this means, and do not have" +$ echo "any program requiring anything, choose the default." +$ dflt = be_case_sensitive +$ rp = "Build with case-sensitive symbols? [''dflt'] " +$ GOSUB myread +$ IF ans .EQS. "" THEN ans="''dflt'" +$ be_case_sensitive = "''ans'" $! IEEE math? -$ echo "" -$ echo "Perl normally uses G_FLOAT format floating point numbers -$ echo "internally, as do most things on VMS. You can, however, build -$ echo "with IEEE floating point numbers instead if you need to. -$ dflt = use_ieee_math -$ rp = "Use IEEE math [''dflt'] " -$ gosub myread -$ if ans.eqs."" then ans="''dflt'" -$ use_ieee_math = "''ans'" -$ endif +$ echo "" +$ echo "Perl normally uses G_FLOAT format floating point numbers" +$ echo "internally, as do most things on VMS. You can, however, build" +$ echo "with IEEE floating point numbers instead if you need to." +$ dflt = use_ieee_math +$ rp = "Use IEEE math? [''dflt'] " +$ GOSUB myread +$ IF ans .eqs. "" THEN ans = "''dflt'" +$ use_ieee_math = "''ans'" +$ ENDIF $! CC Flags $ echo "" -$ echo "You can, if you need to, pass extra flags on to the C -$ echo "compiler. In general you should only do this if you really, -$ echo "really know what you're doing. +$ echo "Your compiler may want other flags. For this question you should include" +$ echo "/INCLUDE=(whatever) and /DEFINE=(whatever), flags and any other flags" +$ echo "or qualifiers used by the compiler." +$ echo "" +$ echo "To use no flags, specify the word ""none""." $ dflt = user_c_flags -$ rp = "Extra C flags [''dflt'] " -$ gosub myread -$ if ans.eqs."" then ans="''dflt'" +$ rp = "Any additional cc flags? [''dflt'] " +$ GOSUB myread +$ IF ans .EQS. "" THEN ans = "''dflt'" +$ IF ans .EQS. "none" THEN ans = "" $ user_c_flags = "''ans'" $! $! Ask whether they want to use secure logical translation when tainting @@ -1929,8 +2308,11 @@ $ echo "name translation." $ dflt = "y" $ rp = "Use secure logical name translation? [''dflt'] " $ GOSUB myread -$ if ans.eqs."" then ans="''dflt'" -$ d_secintgenv = f$extract(0, 1, f$edit(ans,"TRIM,COMPRESS,UPCASE")) +$ IF ans .eqs. "" THEN ans = dflt +$ IF ans +$ THEN d_secintgenv := Y +$ ELSE d_secintgenv := N +$ ENDIF $! $! Ask whether they want to default filetypes $ echo "" @@ -1942,47 +2324,56 @@ $ echo "file types of nothing, .pl, and .com, in that order (e.g. typing" $ echo """$ perl foo"" would cause Perl to look for foo., then foo.pl, and" $ echo "finally foo.com)." $ echo "" -$ echo "This is currently broken in some configurations. Only enable it if -$ echo "you know what you're doing. " -$ dflt = "N" +$ echo "This is currently broken in some configurations. Only enable it if" +$ echo "you know what you are doing." +$ dflt = "n" $ rp = "Always use default file types? [''dflt'] " $ GOSUB myread -$ if ans.eqs."" then ans="''dflt'" -$ d_alwdeftype = f$extract(0, 1, f$edit(ans,"COLLAPSE,UPCASE")) -$! +$ IF ans .EQS. "" THEN ans = dflt +$ IF ans +$ THEN d_alwdeftype := Y +$ ELSE d_alwdeftype := N +$ ENDIF $! Ask if they want to use perl's memory allocator $ echo "" -$ echo "Perl has a built-in memory allocator that's tuned for perl's -$ echo "normal memory usage. It's oftentimes better than the standard -$ echo "system memory allocator. It also has the advantage of providing -$ echo "memory allocation statistics, if you choose to enable them. +$ echo "Perl has a built-in memory allocator that is tuned for normal" +$ echo "memory usage. It is oftentimes better than the standard system" +$ echo "memory allocator. It also has the advantage of providing memory" +$ echo "allocation statistics, if you choose to enable them." $ dflt = "n" -$ rp = "Build with perl's memory allocator? [''dflt'] " -$ GOSUB myread -$ if ans.eqs."" then ans="''dflt'" -$ mymalloc = f$extract(0, 1, f$edit(ans,"COLLAPSE,UPCASE")) -$ if mymalloc.eqs."Y" +$ IF F$TYPE(usemymalloc) .EQS. "STRING" $ THEN -$ if use_debugging_perl.eqs."Y" +$ IF usemymalloc THEN dflt = "y" +$ ENDIF +$ rp = "Do you wish to attempt to use the malloc that comes with ''package'? [''dflt'] " +$ GOSUB myread +$ IF ans .eqs. "" THEN ans = dflt +$ IF ans +$ THEN mymalloc := Y +$ ELSE mymalloc := N +$ ENDIF +$ IF mymalloc +$ THEN +$ IF use_debugging_perl $ THEN $ echo "" -$ echo "Perl can keep statistics on memory usage if you choose to use -$ echo "them. This is useful for debugging, but does have some -$ echo "performance overhead. +$ echo "Perl can keep statistics on memory usage if you choose to use" +$ echo "them. This is useful for debugging, but does have some" +$ echo "performance overhead." $ dflt = "n" $ rp = "Do you want the debugging memory allocator? [''dflt'] " $ gosub myread -$ if ans.eqs."" then ans="''dflt'" +$ IF ans .eqs. "" THEN ans = "''dflt'" $ use_debugmalloc = f$extract(0, 1, f$edit(ans, "COLLAPSE,UPCASE")) $ ENDIF $ ! Check which memory allocator we want $ echo "" -$ echo "There are currently three different memory allocators: the -$ echo "default (which is a pretty good general-purpose memory manager), -$ echo "the TWO_POT allocator (which is optimized to save memory for -$ echo "larger allocations), and PACK_MALLOC (which is optimized to save -$ echo "memory for smaller allocations). They're all good, but if your -$ echo "usage tends towards larger chunks use TWO_POT, otherwise use +$ echo "There are currently three different memory allocators: the" +$ echo "default (which is a pretty good general-purpose memory manager)," +$ echo "the TWO_POT allocator (which is optimized to save memory for" +$ echo "larger allocations), and PACK_MALLOC (which is optimized to save" +$ echo "memory for smaller allocations). They're all good, but if your" +$ echo "usage tends towards larger chunks use TWO_POT, otherwise use" $ echo "PACK_MALLOC." $ dflt = "DEFAULT" $ rp = "Memory allocator (DEFAULT, TWO_POT, PACK_MALLOC) [''dflt'] " @@ -1994,17 +2385,15 @@ $ ENDIF $! $! Ask for their default list of extensions to build $ echo "" -$ echo "It's time to specify which modules you want to build into -$ echo "perl. Most of these are standard and should be chosen, though -$ echo "you might, for example, want to build GDBM_File instead of -$ echo "SDBM_File if you have the GDBM library built on your machine. -$ echo "Whatever you do, make sure the re module is first or things will -$ echo "break badly" -$ echo " +$ echo "It is time to specify which modules you want to build into" +$ echo "perl. Most of these are standard and should be chosen, though" +$ echo "you might, for example, want to build GDBM_File instead of" +$ echo "SDBM_File if you have the GDBM library built on your machine." +$ echo "" $ echo "Which modules do you want to build into perl?" $! dflt = "Fcntl Errno File::Glob IO Opcode Byteloader Devel::Peek Devel::DProf Data::Dumper attrs re VMS::Stdio VMS::DCLsym B SDBM_File" $ dflt = "re Fcntl Errno File::Glob IO Opcode Devel::Peek Devel::DProf Data::Dumper attrs VMS::Stdio VMS::DCLsym B SDBM_File Thread Sys::Hostname" -$ if Using_Dec_C.eqs."Yes" +$ IF ccname .EQS. "DEC" .OR. ccname .EQS. "CXX" $ THEN $ dflt = dflt + " POSIX" $ ENDIF @@ -2046,11 +2435,11 @@ $ exloop3: $ dflt = f$edit(a,"trim") $! $ extensions = "''ans'" -$ perl_known_extensions = "''dflt'" +$ known_extensions = "''dflt'" $! $! %Config-I-VMS, determine build/make utility here (make gmake mmk mms) $ echo "" -$ echo "%Config-I-VMS, Checking your ""make"" utilities..." +$ echo "Checking your ""make"" utilities..." $! If the 'build' that you use is not here add it and it's test $! switch to the _END_ of these strings (and increment max_build) $! (e.g. builders = builders + "/FOOMAKE" @@ -2073,11 +2462,16 @@ $Build_probe: $ build = F$ELEMENT(n,"/",builders) $ probe = F$ELEMENT(n,"!",probers) $ echo "Testing whether you have ''build' on your system..." +$! +$! Noted with GNU Make version 3.60 that the $status and $severity +$! with the 'probe' Makefile appear to be: $STATUS == "%X1000000C" +$! $SEVERITY == "4". +$! $ SET NOON $ ON CONTROL_Y THEN GOTO Reenable_messages_build $ SET MESSAGE/NOFAC/NOSEV/NOIDENT/NOTEXT $ 'build' 'probe' -$ IF ($SEVERITY .EQ. 1) +$ IF ($SEVERITY .EQ. 1) ! not adequate? $ THEN $ echo "OK." $ IF (build .EQS. orig_dflt) @@ -2101,7 +2495,7 @@ $ IF (ok_builders .NES. "") $ THEN $ echo "Here is the list of builders you can apparently use:" $ echo "(",ok_builders," )" -$ rp = "Which """"make"""" utility do you wish to use [''dflt']? " +$ rp = "Which """"make"""" utility do you wish to use? [''dflt'] " $ GOSUB myread $ ans = F$EDIT(ans,"TRIM, COMPRESS") $ ans = F$EXTRACT(0,F$LOCATE(" ",ans),ans) !throw out "-f Makefile." here @@ -2111,18 +2505,20 @@ $ ELSE build = ans $ ENDIF $ ELSE $ TYPE SYS$INPUT: +$ DECK %Config-E-VMS, ERROR: Well this looks pretty serious. Perl5 cannot be compiled without a "make" utility of some sort and after checking my "builders" list I cannot find the symbol or command you use on your system to compile programs. -$ READ SYS$COMMAND/PROMPT="%Config-I-VMS, Which ""MMS"" do you use? " ans +$ EOD +$ READ SYS$COMMAND/PROMPT="Which ""MMS"" do you use? " ans $ ans = F$EDIT(ans,"TRIM, COMPRESS") $ ans = F$EXTRACT(0,F$LOCATE(" ",ans),ans) !throw out "-f Makefile." here $ IF (ans .EQS. "") $ THEN build = dflt -$ echo "I don't know where 'make' is, and my life depends on it." +$ echo "I do not know where ""make"" is, and my life depends on it." $ echo "Go find a make program or fix your DCL$PATH setting!" $ echo "ABORTING..." $ SET DEFAULT 'vms_default_directory_name' !be kind rewind @@ -2137,13 +2533,17 @@ $ DELETE/NOLOG Makefile.; $ GOTO Beyond_open $Open_error: $ TYPE SYS$INPUT: +$ DECK There seems to be trouble. I just tried to create a file in +$ EOD $ echo4 'F$ENVIRONMENT("DEFAULT")' $ TYPE SYS$INPUT: +$ DECK but was unsuccessful. I am stopping now. Please check that directories' PROTECTION bits. I will leave you in the directory where you started Configure.com +$ EOD $ echo4 "ABORTING..." $ GOTO Clean_up $ STOP @@ -2155,7 +2555,17 @@ $ make = F$EDIT(build,"UPCASE") $! $!: locate the preferred pager for this system $!pagers = "most|more|less|type/page" -$!rp='What pager is used on your system?' +$ dflt = "type/page" +$! assume that the presence of a most symbol indicates the presence +$! of the pager. +$ IF F$TYPE(most) .EQS. "STRING" THEN dflt = "most" +$ IF F$TYPE(pager) .EQS. "STRING" THEN dflt = pager +$ rp="What pager is used on your system? [''dflt'] " +$ GOSUB myread +$ IF (ans .EQS. "") +$ THEN pager = dflt +$ ELSE pager = ans +$ ENDIF $! $! update [.vms]config.vms here $! @@ -2167,38 +2577,3066 @@ $ THEN $ makefile = "" !wrt MANIFEST dir $ UUmakefile = "[-]DESCRIP.MMS" !wrt CWD dir $ DEFmakefile = "DESCRIP.MMS" !wrt DEF dir (?) +$ Makefile_SH = "descrip_mms.template" $ ELSE $ makefile = " -f Makefile." !wrt MANIFEST dir $ UUmakefile = "[-]Makefile." !wrt CWD dir $ DEFmakefile = "Makefile." !wrt DEF dir (?) +$ Makefile_SH = "Makefile.in" $ ENDIF $! -$ IF macros.NES."" -$ THEN +$ IF macros .NES. "" +$ THEN $ tmp = F$LENGTH(macros) $ macros = F$EXTRACT(0,(tmp-1),macros) !miss trailing comma $ macros = "/macro=(" + macros + ")" $ ENDIF $! Build up the extra C flags $! -$ if use_ieee_math -$ then +$ IF use_ieee_math +$ THEN $ extra_flags = "''extra_flags'" + "/float=ieee/ieee=denorm_results" -$ endif -$ if be_case_sensitive -$ then +$ ENDIF +$ IF be_case_sensitive +$ THEN $ extra_flags = "''extra_flags'" + "/Names=As_Is" -$ endif +$ ENDIF $ extra_flags = "''extra_flags'" + "''user_c_flags'" $! -$! Invoke the subconfig piece +$ min_pgflquota = "100000" +$ pgflquota = F$STRING(F$GETJPI("","PGFLQUOTA")) +$ IF pgflquota .LES. min_pgflquota +$ THEN +$ echo4 "Your PGFLQUOTA of ''pgflquota' appears too small to build ''package'." +$ READ SYS$COMMAND/PROMPT="Continue? [n] " ans +$ IF ans +$ THEN +$ echo4 "Continuing..." +$ ELSE +$ echo4 "ABORTING..." +$ GOTO Clean_up +$ ENDIF +$ ENDIF $! $ echo "" -$ echo4 "Checking the C run-time library" -$ dflt = F$ENVIRONMENT("DEFAULT") -$ SET DEFAULT [-.vms] -$ @subconfigure -$ SET DEFAULT 'dflt +$ echo4 "Checking the C run-time library." +$! +$! Former SUBCONFIGURE.COM +$! +$! - build a config.sh for VMS Perl. +$! - use built config.sh to take config_h.SH -> config.h +$! - also take vms/descrip_mms.template -> descrip.mms (VMS Makefile) +$! vms/Makefile.in -> Makefile. (VMS GNU Makefile?) +$! vms/Makefile.SH -> Makefile. (VMS GNU Makefile?) +$! - build make_ext.com extension builder procedure. +$! +$! Note for folks from other platforms changing things in here: +$! +$! Fancy changes (based on compiler capabilities or VMS version or +$! whatever) are tricky, so go ahead and punt on those. +$! +$! Simple changes, though (say, always setting something to 1, or undef, +$! or something like that) are straightforward. Adding a new constant +$! item for the ultimately created config.sh requires at least one +$! (possibly more) line(s) to this file. +$! +$! Add a line in the format: +$! +$! $ WC "foo='undef'" +$! +$! somewhere between the line tagged '##BEGIN WRITE NEW CONSTANTS HERE##' +$! and the one tagged '##END WRITE NEW CONSTANTS HERE##' (note the order +$! is sorted ASCII and corresponds to the output of config.sh in the +$! Bourne shell version of Configure). +$! Be very careful with quoting, as it can be tricky. +$! For example if instead of a constant string like 'undef' or 'define' +$! you wanted to add something to VMS's config.sh that looks like: +$! +$! blank_string='' +$! +$! then add a line that looks like this before the +$! '##END WRITE NEW CONSTANTS HERE##' tagged line: +$! +$! $ WC "blank_string='" + "'" +$! +$! (+ is the string concatenator and "''var'" has the effect +$! of "${var}" in perl or sh, but "'const'" is not interpolated). +$! +$! Note that unitialized variables, such as a line like: +$! +$! $ WC "new_var='" + new_var + "'" +$! +$! should be avoided unless new_var has a value assigned prior +$! to that line (think of perl's -w warnings). +$! +$! %DCL-W-UNDSYM, undefined symbol - check validity and spelling +$! \NEW_VAR\ +$! +$! +$ vms_ver = F$EXTRACT(1,3, osvers) +$ IF F$LENGTH(Mcc) .EQ. 0 THEN Mcc := "cc" +$ MCC = f$edit(mcc, "UPCASE") +$ C_Compiler_Replace := "CC=CC=''Mcc'''ccflags'" +$ IF ccname .EQS. "DEC" +$ THEN +$ Checkcc := "''Mcc'/prefix=all" +$ ELSE +$ IF ccname .EQS. "CXX" +$ THEN +$ Checkcc := cxx +$ ELSE +$ Checkcc := "''Mcc'" +$ ENDIF +$ ENDIF +$ ccflags = ccflags + extra_flags +$ IF be_case_sensitive +$ THEN +$ d_vms_be_case_sensitive = "define" +$ ELSE +$ d_vms_be_case_sensitive = "undef" +$ ENDIF +$! Some constant defaults. +$ hwname = f$getsyi("HW_NAME") +$ myname = myhostname +$ IF myname .EQS. "" THEN myname = F$TRNLNM("SYS$NODE") +$! +$ ccdlflags="" +$ cccdlflags="" +$! +$ IF use64bitint .OR. use64bitint .EQS. "define" +$ THEN +$ use64bitint = "define" +$ uselargefiles = "define" +$ uselongdouble = "define" +$ alignbytes="16" +$ usemorebits = "define" +$ ELSE +$ use64bitint = "undef" +$ uselargefiles = "undef" +$ uselongdouble = "undef" +$ usemorebits = "undef" +$ ENDIF +$ IF use64bitall .OR. use64bitall .EQS. "define" +$ THEN +$ use64bitall = "define" +$ ELSE +$ use64bitall = "undef" +$ ENDIF +$! +$ usemymalloc=mymalloc +$! +$ perl_cc=Mcc +$! +$ IF (sharedperl .AND. F$GETSYI("HW_MODEL") .GE. 1024) +$ THEN +$ obj_ext=".abj" +$ so="axe" +$ dlext="axe" +$ exe_ext=".axe" +$ lib_ext=".alb" +$ ELSE +$ obj_ext=".obj" +$ so="exe" +$ dlext="exe" +$ exe_ext=".exe" +$ lib_ext=".olb" +$ ENDIF +$ dlobj="dl_vms''obj_ext'" +$! +$ cppstdin="''perl_cc'/noobj/preprocess=sys$output sys$input" +$ cppminus=" " +$ cpprun="''perl_cc'/noobj/preprocess=sys$output sys$input" +$ cpplast=" " +$! +$ timetype="time_t" +$ signal_t="void" +$ stdchar="char" +$! +$ IF mymalloc +$ THEN d_mymalloc="define" +$ ELSE d_mymalloc="undef" +$ ENDIF +$! +$ usedl="define" +$ startperl="""$ perl 'f$env(\""procedure\"")' \""'"+"'p1'\"" \""'"+"'p2'\"" \""'"+"'p3'\"" \""'"+"'p4'\"" \""'"+"'p5'\"" \""'"+"'p6'\"" \""'"+"'p7'\"" \""'"+"'p8'\""!\n" +$ startperl=startperl + "$ exit++ + ++$status!=0 and $exit=$status=undef; while($#ARGV != -1 and $ARGV[$#ARGV] eq '"+"'){pop @ARGV;}""" +$! +$ IF ((Use_Threads) .AND. (vms_ver .LES. "6.2")) +$ THEN +$ libs="SYS$SHARE:CMA$LIB_SHR.EXE/SHARE SYS$SHARE:CMA$RTL.EXE/SHARE SYS$SHARE:CMA$OPEN_LIB_SHR.exe/SHARE SYS$SHARE:CMA$OPEN_RTL.exe/SHARE" +$ ELSE +$ libs=" " +$ ENDIF +$ IF ccname .EQS. "DEC" .OR. ccname .EQS. "CXX" +$ THEN +$ libc="(DECCRTL)" +$ ELSE +$ libc=" " +$ ENDIF +$! +$! perllibs should be libs with all non-core libs (such as gdbm) removed. +$! +$ perllibs=libs +$! +$! Are we 64 bit? +$! +$ IF use64bitint .OR. use64bitint .EQS. "define" +$ THEN +$ d_PRId64 = "define" +$ d_PRIEUldbl = "define" +$ d_PRIFUldbl = "define" +$ d_PRIGUldbl = "define" +$ d_PRIXU64 = "define" +$ d_PRIeldbl = "define" +$ d_PRIfldbl = "define" +$ d_PRIgldbl = "define" +$ d_PRIu64 = "define" +$ d_PRIo64 = "define" +$ d_PRIx64 = "define" +$ sPRId64 = """Ld""" +$ sPRIEUldbl = """LE""" +$ sPRIFUldbl = """LF""" +$ sPRIGUldbl = """LG""" +$ sPRIXU64 = """LX""" +$ sPRIeldbl = """Le""" +$ sPRIfldbl = """Lf""" +$ sPRIgldbl = """Lg""" +$ sPRIi64 = """Li""" +$ sPRIo64 = """Lo""" +$ sPRIu64 = """Lu""" +$ sPRIx64 = """Lx""" +$ d_quad = "define" +$ quadtype = "long long" +$ uquadtype = "unsigned long long" +$ quadkind = "QUAD_IS_LONG_LONG" +$ d_frexpl = "define" +$ d_isnan = "define" +$ d_isnanl = "define" +$ d_modfl = "define" +$ ELSE +$ d_PRId64 = "undef" +$ d_PRIEUldbl = "define" +$ d_PRIFUldbl = "define" +$ d_PRIGUldbl = "define" +$ d_PRIXU64 = "undef" +$ d_PRIeldbl = "define" +$ d_PRIfldbl = "undef" +$ d_PRIgldbl = "undef" +$ d_PRIu64 = "undef" +$ d_PRIo64 = "undef" +$ d_PRIx64 = "undef" +$ sPRId64 = "" +$ sPRIEUldbl = """E""" +$ sPRIFUldbl = """F""" +$ sPRIGUldbl = """G""" +$ sPRIXU64 = """lX""" +$ sPRIeldbl = """e""" +$ sPRIfldbl = """f""" +$ sPRIgldbl = """g""" +$ sPRIi64 = "" +$ sPRIo64 = "" +$ sPRIu64 = "" +$ sPRIx64 = "" +$ d_quad = "undef" +$ quadtype = "long" +$ uquadtype = "unsigned long" +$ quadkind = "QUAD_IS_LONG" +$ d_frexpl = "undef" +$ d_isnan = "undef" +$ d_isnanl = "undef" +$ d_modfl = "undef" +$ ENDIF +$ d_SCNfldbl = d_PRIfldbl +$ sSCNfldbl = sPRIfldbl ! expect consistency +$! +$! Now some that we build up +$! +$ IF Use_Threads +$ THEN +$ IF use_5005_threads +$ THEN +$ arch = "''arch'-thread" +$ archname = "''archname'-thread" +$ d_old_pthread_create_joinable = "undef" +$ old_pthread_create_joinable = " " +$ use5005threads = "define" +$ useithreads = "undef" +$ ELSE +$ arch = "''arch'-ithread" +$ archname = "''archname'-ithread" +$ d_old_pthread_create_joinable = "undef" +$ old_pthread_create_joinable = " " +$ use5005threads = "undef" +$ useithreads = "define" +$ ENDIF +$ ELSE +$ d_old_pthread_create_joinable = "undef" +$ old_pthread_create_joinable = " " +$ use5005threads = "undef" +$ useithreads = "undef" +$ ENDIF +$! +$! Some that we need to invoke the compiler for +$! +$! +$! handy construction aliases/symbols +$! +$ OS := "open/write CONFIG []try.c" +$ WS := "write CONFIG" +$ CS := "close CONFIG" +$ DS := "delete/nolog/noconfirm []try.*;*" +$ Needs_Opt := N +$ good_compile = %X10B90001 +$ IF ccname .EQS. "GCC" +$ THEN +$ open/write OPTCHAN []try.opt +$ write OPTCHAN "Gnu_CC:[000000]gcclib.olb/library" +$ write OPTCHAN "Sys$Share:VAXCRTL/Share" +$ Close OPTCHAN +$ Needs_Opt := Y +$ good_compile = %X10000001 +$ ENDIF +$ IF ccname .EQS. "CXX" +$ THEN +$ good_compile = %X15F60001 +$ ENDIF +$ good_link = %X10000001 +$ tmp = "" ! null string default +$! +$ GOTO beyond_compile_ok +$! +$! Check for type sizes +$! +$type_size_check: +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "printf(""%d\n"", sizeof(''tmp'));" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB compile +$ RETURN +$! +$!: locate header file +$findhdr: +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include <''tmp'>" +$ WS "int main()" +$ WS "{" +$ WS "printf(""define\n"");" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB link_ok +$ RETURN +$! +$!: define an alternate in-header-list? function +$inhdr: +$! +$ GOSUB findhdr +$ IF compile_status .EQ. good_compile .AND. link_status .EQ. good_link +$ THEN +$ echo4 "<''tmp'> found." +$ tmp = "define" +$ ELSE +$ echo4 "<''tmp'> NOT found." +$ tmp = "undef" +$ ENDIF +$ RETURN +$! +$!: define an is-in-libc? function +$inlibc: +$ GOSUB link_ok +$ IF compile_status .EQ. good_compile .AND. link_status .EQ. good_link +$ THEN +$ echo4 "''tmp'() found." +$ tmp = "define" +$ ELSE +$ echo4 "''tmp'() NOT found." +$ tmp = "undef" +$ ENDIF +$ RETURN +$! +$!: define a shorthand compile call +$compile: +$ GOSUB link_ok +$just_mcr_it: +$ IF compile_status .EQ. good_compile .AND. link_status .EQ. good_link +$ THEN +$ OPEN/WRITE CONFIG []try.out +$ DEFINE/USER_MODE SYS$ERROR CONFIG +$ DEFINE/USER_MODE SYS$OUTPUT CONFIG +$ MCR []try.exe +$ CLOSE CONFIG +$ OPEN/READ CONFIG []try.out +$ READ CONFIG tmp +$ CLOSE CONFIG +$ DELETE/NOLOG/NOCONFIRM []try.out; +$ DELETE/NOLOG/NOCONFIRM []try.exe; +$ ELSE +$ tmp = "" ! null string default +$ ENDIF +$ RETURN +$! +$link_ok: +$ GOSUB compile_ok +$ DEFINE/USER_MODE SYS$ERROR _NLA0: +$ DEFINE/USER_MODE SYS$OUTPUT _NLA0: +$ SET NOON +$ IF Needs_Opt +$ THEN +$ 'ld' try.obj,try.opt/opt +$ link_status = $status +$ ELSE +$ 'ld' try.obj +$ link_status = $status +$ ENDIF +$ SET ON +$ IF F$SEARCH("try.obj") .NES. "" THEN DELETE/NOLOG/NOCONFIRM try.obj; +$ RETURN +$! +$!: define a shorthand compile call for compilations that should be ok. +$compile_ok: +$ DEFINE/USER_MODE SYS$ERROR _NLA0: +$ DEFINE/USER_MODE SYS$OUTPUT _NLA0: +$ SET NOON +$ 'Checkcc' try.c +$ compile_status = $status +$ SET ON +$ DELETE/NOLOG/NOCONFIRM try.c; +$ RETURN +$! +$beyond_compile_ok: +$! +$! Check for __STDC__ +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "#ifdef __STDC__" +$ WS "printf(""42\n"");" +$ WS "#else" +$ WS "printf(""1\n"");" +$ WS "#endif" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB compile +$ cpp_stuff=tmp +$ IF F$INTEGER(tmp) .eq. 42 +$ THEN +$ echo4 "Your C compiler and pre-processor defines the symbol:" +$ echo4 "__STDC__" +$ ENDIF +$! +$! Check for double size +$! +$ echo4 "Checking to see how big your double precision numbers are..." +$ tmp="double" +$ GOSUB type_size_check +$ doublesize = tmp +$ echo "Your double is ''doublesize' bytes long." +$! +$! Check for long double size +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "printf(""%d\n"", sizeof(long double));" +$ WS "exit(0);" +$ WS "}" +$ CS +$ echo4 "Checking to see if you have long double..." +$ GOSUB link_ok +$ IF link_status .NE. good_link +$ THEN +$ longdblsize="0" +$ d_longdbl="undef" +$ echo "You do not have long double." +$ ELSE +$ echo "You have long double." +$ echo4 "Checking to see how big your long doubles are..." +$ GOSUB just_mcr_it +$ longdblsize = tmp +$ d_longdbl = "define" +$ echo "Your long doubles are ''longdblsize' bytes long." +$ ENDIF +$! +$!: check for long long +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "printf(""%d\n"", sizeof(long long));" +$ WS "exit(0);" +$ WS "}" +$ CS +$ echo4 "Checking to see if you have long long..." +$ GOSUB link_ok +$ IF link_status .NE. good_link +$ THEN +$ longlongsize="0" +$ d_longlong="undef" +$ echo "You do not have long long." +$ ELSE +$ echo "You have long long." +$ echo4 "Checking to see how big your long longs are..." +$ GOSUB just_mcr_it +$ longlongsize = tmp +$ d_longlong = "define" +$ echo "Your long longs are ''longlongsize' bytes long." +$ ENDIF +$! +$! Check the prototype for getgid +$! +$ echo "Looking for the type for group ids returned by getgid()." +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "gid_t foo;" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB compile_ok +$ IF compile_status .NE. good_compile +$ THEN +$! Okay, gid_t failed. Must be unsigned int +$ gidtype = "unsigned int" +$ echo4 "assuming ""''gidtype'""." +$ ELSE +$ gidtype = "gid_t" +$ echo4 "gid_t found." +$ ENDIF +$! +$! Check to see if we've got dev_t +$! +$ echo "Looking for the type for dev." +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "dev_t foo;" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB compile_ok +$ IF compile_status .NE. good_compile +$ THEN +$! Okay, dev_t failed. Must be unsigned int +$ devtype = "unsigned int" +$ echo4 "assuming ""''devtype'""." +$ ELSE +$ devtype = "dev_t" +$ echo4 "dev_t found." +$ ENDIF +$! +$! Check to see if we've got unistd.h (which we ought to, but you never know) +$! +$ i_netdb = "undef" +$ tmp = "unistd.h" +$ GOSUB inhdr +$ i_unistd = tmp +$! +$!: see if this is a libutil.h system +$! +$ tmp = "libutil.h" +$ GOSUB inhdr +$ i_libutil = tmp +$! +$! Check to see if we've got shadow.h (probably not, but...) +$! +$ tmp = "shadow.h" +$ GOSUB inhdr +$ i_shadow = tmp +$! +$! Check to see if we've got socks.h (probably not, but...) +$! +$ tmp = "socks.h" +$ GOSUB inhdr +$ i_socks = tmp +$! +$! Check the prototype for select +$! +$ IF Has_Dec_C_Sockets .OR. Has_Socketshr +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ IF i_unistd .EQS. "define" THEN WS "#include " +$ IF Has_Socketshr +$ THEN +$ WS "#include " +$ ELSE +$ WS "#include " +$ WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "fd_set *foo;" +$ WS "int bar;" +$ WS "foo = NULL;" +$ WS "bar = select(2, foo, foo, foo, NULL);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB compile_ok +$ IF compile_status .NE. good_compile +$ THEN +$! Okay, select failed. Must be an int * +$ selecttype = "int *" +$ echo4 "select() NOT found." +$ ELSE +$ selecttype="fd_set *" +$ echo4 "select() found." +$ ENDIF +$ ELSE +$ ! No sockets, so stick in an int * : no select, so pick a harmless default +$ selecttype = "int *" +$ ENDIF +$! +$! Check to see if fd_set exists +$! +$ echo "Checking to see how well your C compiler handles fd_set and friends ..." +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ IF Has_Socketshr +$ THEN +$ WS "#include " +$ ENDIF +$ IF Has_Dec_C_Sockets +$ THEN +$ WS "#include " +$ WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "fd_set *foo;" +$ WS "int bar;" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB compile_ok +$ IF compile_status .ne. good_compile +$ THEN +$! Okay, fd_set failed. Must not exist +$ d_fd_set = "undef" +$ echo4 "Hmm, your compiler has some difficulty with fd_set." +$ ELSE +$ d_fd_set="define" +$ echo4 "Well, your system knows about the normal fd_set typedef..." +$ ENDIF +$! +$! Check for inttypes.h +$! +$ tmp = "inttypes.h" +$ GOSUB inhdr +$ i_inttypes = tmp +$! +$! Check to see if off64_t exists +$! +$ echo4 "Checking to see if you have off64_t..." +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ WS "#''i_inttypes' IIH" +$ WS "#ifdef IIH" +$ WS "#include " +$ WS "#endif" +$ WS "int main()" +$ WS "{" +$ WS "off64_t bar;" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB compile_ok +$ IF compile_status .EQ. good_compile +$ THEN +$ d_off64_t="define" +$ echo "You have off64_t." +$ ELSE +$ d_off64_t = "undef" +$ echo "You do not have off64_t." +$ ENDIF +$! +$! Check to see if fpos64_t exists +$! +$ echo4 "Checking to see if you have fpos64_t..." +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ WS "#''i_inttypes' IIH" +$ WS "#ifdef IIH" +$ WS "#include " +$ WS "#endif" +$ WS "int main()" +$ WS "{" +$ WS "fpos64_t bar;" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB compile_ok +$ IF compile_status .EQ. good_compile +$ THEN +$ d_fpos64_t="define" +$ echo "You have fpos64_t." +$ ELSE +$ d_fpos64_t = "undef" +$ echo "You do not have fpos64_t." +$ ENDIF +$! +$! Check to see if int64_t exists +$! +$ echo4 "Checking to see if you have int64_t..." +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ WS "#''i_inttypes' IIH" +$ WS "#ifdef IIH" +$ WS "#include " +$ WS "#endif" +$ WS "int main()" +$ WS "{" +$ WS "int64_t bar;" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB compile_ok +$ IF compile_status .EQ. good_compile +$ THEN +$ d_int64_t="define" +$ echo "You have int64_t." +$ ELSE +$ d_int64_t = "undef" +$ echo "You do not have int64_t." +$ ENDIF +$! +$!: see if this is a netdb.h system +$ IF Has_Dec_C_Sockets +$ THEN +$ tmp = "netdb.h" +$ GOSUB inhdr +$ i_netdb = tmp +$ ENDIF +$! +$! Check for h_errno +$! +$ echo4 "Checking to see if you have h_errno..." +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ IF i_unistd .EQS. "define" THEN WS "#include " +$ IF i_netdb .EQS. "define" THEN WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "h_errno = 3;" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB link_ok +$ IF compile_status .EQ. good_compile .AND. link_status .EQ. good_link +$ THEN +$ d_herrno="define" +$ echo "You have h_errno." +$ ELSE +$ d_herrno="undef" +$ echo "You do not have h_errno." +$ ENDIF +$! +$! Check to see if gethostname exists +$! +$ IF Has_Dec_C_Sockets .OR. Has_Socketshr +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ IF Has_Socketshr +$ THEN +$ WS "#include " +$ ELSE +$ WS "#include " +$ WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "char name[100];" +$ WS "int bar, baz;" +$ WS "bar = 100;" +$ WS "baz = gethostname(name, bar);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB link_ok +$ IF compile_status .EQ. good_compile .AND. link_status .EQ. good_link +$ THEN +$ d_gethname="define" +$ echo4 "gethostname() found." +$ ELSE +$ d_gethname="undef" +$ ENDIF +$ ELSE +$ ! No sockets, so no gethname +$ d_gethname = "undef" +$ ENDIF +$! +$! Check for sys/file.h +$! +$ tmp = "sys/file.h" +$ GOSUB inhdr +$ i_sysfile = tmp +$! +$! Check for sys/utsname.h +$! +$ tmp = "sys/utsname.h" +$ GOSUB inhdr +$ i_sysutsname = tmp +$! +$! Check for syslog.h +$! +$ tmp = "syslog.h" +$ GOSUB inhdr +$ i_syslog = tmp +$! +$! Check for poll.h +$! +$ tmp = "poll.h" +$ GOSUB inhdr +$ i_poll = tmp +$! +$! Check for sys/uio.h +$! +$ tmp = "sys/uio.h" +$ GOSUB inhdr +$ i_sysuio = tmp +$! +$! Check for sys/mode.h +$! +$ tmp = "sys/mode.h" +$ GOSUB inhdr +$ i_sysmode = tmp +$! +$! Check for sys/access.h +$! +$ tmp = "sys/access.h" +$ GOSUB inhdr +$ i_sysaccess = tmp +$! +$! Check for sys/security.h +$! +$ tmp = "sys/security.h" +$ GOSUB inhdr +$ i_syssecrt = tmp +$! +$! Check for fcntl.h +$! +$ tmp = "fcntl.h" +$ GOSUB inhdr +$ i_fcntl = tmp +$! +$! Check for fcntl +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "fcntl(1,2,3);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "fcntl" +$ GOSUB inlibc +$ d_fcntl = tmp +$! +$! Check for fcntl locking capability +$! +$ echo4 "Checking if fcntl-based file locking works... " +$ tmp = "undef" +$ IF d_fcntl .EQS. "define" +$ THEN +$ OS +$ WS "#include " +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ WS "int main() {" +$ WS "#if defined(F_SETLK) && defined(F_SETLKW)" +$ WS " struct flock flock;" +$ WS " int retval, fd;" +$ WS " fd = open(""try.c"", O_RDONLY);" +$ WS " flock.l_type = F_RDLCK;" +$ WS " flock.l_whence = SEEK_SET;" +$ WS " flock.l_start = flock.l_len = 0;" +$ WS " retval = fcntl(fd, F_SETLK, &flock);" +$ WS " close(fd);" +$ WS " (retval < 0 ? printf(""undef\n"") : printf(""define\n""));" +$ WS "#else" +$ WS " printf(""undef\n"");" +$ WS "#endif" +$ WS "}" +$ CS +$ GOSUB link_ok +$ IF compile_status .EQ. good_compile .AND. link_status .EQ. good_link +$ THEN +$ GOSUB just_mcr_it +$ IF tmp .EQS. "define" +$ THEN +$ echo4 "Yes, it seems to work." +$ ELSE +$ echo4 "Nope, it didn't work." +$ ENDIF +$ ELSE +$ echo4 "I'm unable to compile the test program, so I'll assume not." +$ tmp = "undef" +$ ENDIF +$ ELSE +$ echo4 "Nope, since you don't even have fcntl()." +$ ENDIF +$ d_fcntl_can_lock = tmp +$! +$! Check for memchr +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "char * place;" +$ WS "place = memchr(""foo"", 47, 3)" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "memchr" +$ GOSUB inlibc +$ d_memchr = tmp +$! +$! Check for strtoull +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "unsigned __int64 result;" +$ WS "result = strtoull(""123123"", NULL, 10);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "strtoull" +$ GOSUB inlibc +$ d_strtoull = tmp +$! +$! Check for strtouq +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "unsigned __int64 result;" +$ WS "result = strtouq(""123123"", NULL, 10);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "strtouq" +$ GOSUB inlibc +$ d_strtouq = tmp +$! +$! Check for strtoll +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "__int64 result;" +$ WS "result = strtoll(""123123"", NULL, 10);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "strtoll" +$ GOSUB inlibc +$ d_strtoll = tmp +$! +$! Check for strtold +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "long double result;" +$ WS "result = strtold(""123123"", NULL, 10);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "strtold" +$ GOSUB inlibc +$ d_strtold = tmp +$! +$! Check for atoll +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS " __int64 result;" +$ WS "result = atoll(""123123"");" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "atoll" +$ GOSUB inlibc +$ d_atoll = tmp +$! +$! Check for atolf +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "long double" +$ WS "result = atolf(""123123"");" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "atolf" +$ GOSUB inlibc +$ d_atolf = tmp +$! +$! Check for access +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "access(""foo"", F_OK);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "acess" +$ GOSUB inlibc +$ d_access = tmp +$! +$! Check for bzero +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "char foo[10];" +$ WS "bzero(foo, 10);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "bzero" +$ GOSUB inlibc +$ d_bzero = tmp +$! +$! Check for bcopy +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "char foo[10], bar[10];" +$ WS "bcopy(""foo"", bar, 3);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "bcopy" +$ GOSUB inlibc +$ d_bcopy = tmp +$! +$! Check for mkstemp +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "mkstemp(""foo"");" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "mkstemp" +$ GOSUB inlibc +$ d_mkstemp = tmp +$! +$! Check for mkstemps +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "mkstemps(""foo"", 1);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "mkstemps" +$ GOSUB inlibc +$ d_mkstemps = tmp +$! +$! Check for iconv +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS " iconv_t cd = (iconv_t)0;" +$ WS " char *inbuf, *outbuf;" +$ WS " size_t inleft, outleft;" +$ WS " iconv(cd, &inbuf, &inleft, &outbuf, &outleft);" +$ WS " exit(0);" +$ WS "}" +$ CS +$ GOSUB link_ok +$ IF compile_status .ne. good_compile +$ THEN +$ d_iconv="undef" +$ i_iconv="undef" +$ ELSE +$ IF link_status .ne. good_link +$ THEN +$ d_iconv="undef" +$ i_iconv="undef" +$ ELSE +$ d_iconv="define" +$ i_iconv="define" +$ ENDIF +$ ENDIF +$ IF i_iconv .eqs. "define" +$ THEN echo4 " found." +$ ELSE echo4 " NOT found." +$ ENDIF +$! +$! Check for mkdtemp +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "mkdtemp(""foo"");" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "mkdtemp" +$ GOSUB inlibc +$ d_mkdtemp = tmp +$! +$! Check for setvbuf +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "FILE *foo;" +$ WS "char Buffer[99];" +$ WS "foo = fopen(""foo"", ""r"");" +$ WS "setvbuf(foo, Buffer, 0, 0);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "setvbuf" +$ GOSUB inlibc +$ d_setvbuf = tmp +$! +$! Check for setenv +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "setenv(""FOO"", ""BAR"", 0);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "setenv" +$ GOSUB inlibc +$ d_setenv = tmp +$! +$! Check for setproctitle +$! +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "setproctitle(""%s"", ""FOO"");" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "setproctitle" +$ GOSUB inlibc +$ d_setproctitle = tmp +$! +$! Check for +$! +$ IF Has_Dec_C_Sockets .or. Has_Socketshr +$ THEN +$ tmp = "netinet/in.h" +$ GOSUB inhdr +$ i_niin = tmp +$ ELSE +$ i_niin="undef" +$ ENDIF +$! +$! Check for +$! +$ IF Has_Dec_C_Sockets .or. Has_Socketshr +$ THEN +$ tmp = "netinet/tcp.h" +$ GOSUB inhdr +$ i_netinettcp = tmp +$ ELSE +$ i_netinettcp="undef" +$ ENDIF +$! +$! Check for endhostent +$! +$ IF Has_Dec_C_Sockets .or. Has_Socketshr +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ IF Has_Socketshr +$ THEN WS "#include " +$ ELSE IF i_netdb .EQS. "define" THEN WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "endhostent();" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "endhostent" +$ GOSUB inlibc +$ d_endhent = tmp +$ ELSE +$ d_endhent="undef" +$ ENDIF +$! +$! Check for endnetent +$! +$ IF Has_Dec_C_Sockets .or. Has_Socketshr +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ IF Has_Socketshr +$ THEN WS "#include " +$ ELSE IF i_netdb .EQS. "define" THEN WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "endnetent();" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "endnetent" +$ GOSUB inlibc +$ d_endnent = tmp +$ ELSE +$ d_endnent="undef" +$ ENDIF +$! +$! Check for endprotoent +$! +$ IF Has_Dec_C_Sockets .OR. Has_Socketshr +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ IF Has_Socketshr +$ THEN WS "#include " +$ ELSE IF i_netdb .EQS. "define" THEN WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "endprotoent();" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "endprotoent" +$ GOSUB inlibc +$ d_endpent = tmp +$ ELSE +$ d_endpent="undef" +$ ENDIF +$! +$! Check for endservent +$! +$ IF Has_Dec_C_Sockets .OR. Has_Socketshr +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ IF Has_Socketshr +$ THEN WS "#include " +$ ELSE IF i_netdb .EQS. "define" THEN WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "endservent();" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "endservent" +$ GOSUB inlibc +$ d_endsent = tmp +$ ELSE +$ d_endsent="undef" +$ ENDIF +$! +$! Check for sethostent +$! +$ IF Has_Dec_C_Sockets .OR. Has_Socketshr +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ IF Has_Socketshr +$ THEN WS "#include " +$ ELSE IF i_netdb .EQS. "define" THEN WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "sethostent(1);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "sethostent" +$ GOSUB inlibc +$ d_sethent = tmp +$ ELSE +$ d_sethent="undef" +$ ENDIF +$! +$! Check for setnetent +$! +$ IF Has_Dec_C_Sockets .OR. Has_Socketshr +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ IF Has_Socketshr +$ THEN WS "#include " +$ ELSE IF i_netdb .EQS. "define" THEN WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "setnetent(1);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "setnetent" +$ GOSUB inlibc +$ d_setnent = tmp +$ ELSE +$ d_setnent="undef" +$ ENDIF +$! +$! Check for setprotoent +$! +$ IF Has_Dec_C_Sockets .OR. Has_Socketshr +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ IF Has_Socketshr +$ THEN WS "#include " +$ ELSE IF i_netdb .EQS. "define" THEN WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "setprotoent(1);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "setprotoent" +$ GOSUB inlibc +$ d_setpent = tmp +$ ELSE +$ d_setpent="undef" +$ ENDIF +$! +$! Check for setservent +$! +$ IF Has_Dec_C_Sockets .OR. Has_Socketshr +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ IF Has_Socketshr +$ THEN WS "#include " +$ ELSE IF i_netdb .EQS. "define" THEN WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "setservent(1);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "setservent" +$ GOSUB inlibc +$ d_setsent = tmp +$ ELSE +$ d_setsent="undef" +$ ENDIF +$! +$! Check for gethostent +$! +$ IF Has_Dec_C_Sockets .OR. Has_Socketshr +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ IF Has_Socketshr +$ THEN WS "#include " +$ ELSE IF i_netdb .EQS. "define" THEN WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "gethostent();" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "gethostent" +$ GOSUB inlibc +$ d_gethent = tmp +$ ELSE +$ d_gethent="undef" +$ ENDIF +$! +$! Check for getnetent +$! +$ IF Has_Dec_C_Sockets .OR. Has_Socketshr +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ IF Has_Socketshr +$ THEN WS "#include " +$ ELSE IF i_netdb .EQS. "define" THEN WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "getnetent();" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "getnetent" +$ GOSUB inlibc +$ d_getnent = tmp +$ ELSE +$ d_getnent="undef" +$ ENDIF +$! +$! Check for getprotoent +$! +$ IF Has_Dec_C_Sockets .OR. Has_Socketshr +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ IF Has_Socketshr +$ THEN WS "#include " +$ ELSE IF i_netdb .EQS. "define" THEN WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "getprotoent();" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "getprotoent" +$ GOSUB inlibc +$ d_getpent = tmp +$ ELSE +$ d_getpent="undef" +$ ENDIF +$! +$! Check for getservent +$! +$ IF Has_Dec_C_Sockets .OR. Has_Socketshr +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ IF Has_Socketshr +$ THEN WS "#include " +$ ELSE IF i_netdb .EQS. "define" THEN WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "getservent();" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "getservent" +$ GOSUB inlibc +$ d_getsent = tmp +$ ELSE +$ d_getsent="undef" +$ ENDIF +$! +$! Check for socklen_t +$! +$ IF Has_Dec_C_Sockets .OR. Has_Socketshr +$ THEN +$ echo4 "Checking to see if you have socklen_t..." +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ IF Has_Socketshr +$ THEN WS "#include " +$ ELSE IF i_netdb .EQS. "define" THEN WS "#include " +$ ENDIF +$ WS "int main()" +$ WS "{" +$ WS "socklen_t x = 16;" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB link_ok +$ IF compile_status .EQ. good_compile .AND. link_status .EQ. good_link +$ THEN +$ d_socklen_t="define" +$ echo "You have socklen_t." +$ ELSE +$ d_socklen_t="undef" +$ echo "You do not have socklen_t." +$ ENDIF +$ ELSE +$ d_socklen_t="undef" +$ ENDIF +$! +$! Check for pthread_yield +$! +$ IF use_threads +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "pthread_yield();" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "pthread_yield" +$ GOSUB inlibc +$ d_pthread_yield = tmp +$ ELSE +$ d_pthread_yield="undef" +$ ENDIF +$! +$! Check for sched_yield +$! +$ IF use_threads +$ THEN +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "sched_yield();" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "sched_yield" +$ GOSUB inlibc +$ d_sched_yield = tmp +$ IF d_sched_yield .EQS. "define" +$ THEN sched_yield = "sched_yield" +$ ELSE sched_yield = " " +$ ENDIF +$ ELSE +$ d_sched_yield="undef" +$ sched_yield = " " +$ ENDIF +$! +$! Check for generic pointer size +$! +$ echo4 "Checking to see how big your pointers are..." +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "int foo;" +$ WS "foo = sizeof(char *);" +$ WS "printf(""%d\n"", foo);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ tmp = "char *" +$ GOSUB type_size_check +$ ptrsize = tmp +$ echo "Your pointers are ''ptrsize' bytes long." +$! +$! Check for size_t size +$! +$ tmp = "size_t" +$ zzz = tmp +$ echo4 "Checking the size of ''zzz'..." +$ GOSUB type_size_check +$ sizesize = tmp +$ echo "Your ''zzz' size is ''sizesize' bytes." +$! +$! Check rand48 and its ilk +$! +$ echo4 "Looking for a random number function..." +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "srand48(12L);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB link_ok +$ IF compile_status .EQ. good_compile .AND. link_status .EQ. good_link +$ THEN +$ drand01 = "drand48()" +$ randseedtype = "long int" +$ seedfunc = "srand48" +$ echo4 "Good, found drand48()." +$ d_drand48proto = "define" +$ ELSE +$ d_drand48proto = "undef" +$ drand01="random()" +$ randseedtype = "unsigned" +$ seedfunc = "srandom" +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main()" +$ WS "{" +$ WS "srandom(12);" +$ WS "exit(0);" +$ WS "}" +$ CS +$ GOSUB link_ok +$ IF compile_status .EQ. good_compile .AND. link_status .EQ. good_link +$ THEN +$ echo4 "OK, found random()." +$ ELSE +$ drand01="(((float)rand())/((float)RAND_MAX))" +$ randseedtype = "unsigned" +$ seedfunc = "srand" +$ echo4 "Yick, looks like I have to use rand()." +$ ENDIF +$ ENDIF +$! Done with compiler checks. Clean up. +$ IF F$SEARCH("try.c") .NES."" THEN DELETE/NOLOG/NOCONFIRM try.c;* +$ IF F$SEARCH("try.obj").NES."" THEN DELETE/NOLOG/NOCONFIRM try.obj;* +$ IF F$SEARCH("try.exe").NES."" THEN DELETE/NOLOG/NOCONFIRM try.exe;* +$ IF F$SEARCH("try.opt").NES."" THEN DELETE/NOLOG/NOCONFIRM try.opt;* +$ IF F$SEARCH("try.out").NES."" THEN DELETE/NOLOG/NOCONFIRM try.out;* +$ IF ccname .EQS. "CXX" +$ THEN +$ CALL Cxx_demangler_cleanup +$ ENDIF +$! +$! Some that are compiler or VMS version sensitive +$! +$! Gnu C stuff +$ IF ccname .EQS. "GCC" +$ THEN +$ d_attribut="define" +$ vms_cc_type="gcc" +$ ELSE +$ vms_cc_type="cc" +$ d_attribut="undef" +$ ENDIF +$! +$! Dec C >= 5.2 and VMS ver >= 7.0 +$ IF (ccname .EQS. "DEC") .AND. - + (F$INTEGER(Dec_C_Version).GE.50200000) .AND. (vms_ver .GES. "7.0") +$ THEN +$ d_bcmp="define" +$ d_gettimeod="define" +$ d_uname="define" +$ d_sigaction="define" +$ d_truncate="define" +$ d_wait4="define" +$ d_index="define" +$ pidtype="pid_t" +$ sig_name="ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM ABRT USR1 USR2 SPARE18 SPARE19 CHLD CONT STOP TSTP TTIN TTOU DEBUG SPARE27 SPARE28 SPARE29 SPARE30 SPARE31 SPARE32 RTMIN RTMAX"",0" +$ psnwc1="""ZERO"",""HUP"",""INT"",""QUIT"",""ILL"",""TRAP"",""IOT"",""EMT"",""FPE"",""KILL"",""BUS"",""SEGV"",""SYS""," +$ psnwc2="""PIPE"",""ALRM"",""TERM"",""ABRT"",""USR1"",""USR2"",""SPARE18"",""SPARE19"",""CHLD"",""CONT"",""STOP"",""TSTP""," +$ psnwc3="""TTIN"",""TTOU"",""DEBUG"",""SPARE27"",""SPARE28"",""SPARE29"",""SPARE30"",""SPARE31"",""SPARE32"",""RTMIN"",""RTMAX"",0" +$ sig_name_init = psnwc1 + psnwc2 + psnwc3 +$ sig_num="0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 6 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 64"",0" +$ sig_num_init="0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,6,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,64,0" +$! perl_sig_num_with_commas=sig_num_init +$ uidtype="uid_t" +$ d_pathconf="define" +$ d_fpathconf="define" +$ d_sysconf="define" +$ d_sigsetjmp="define" +$ ELSE +$ pidtype="unsigned int" +$ d_gettimeod="undef" +$ d_bcmp="undef" +$ d_uname="undef" +$ d_sigaction="undef" +$ d_truncate="undef" +$ d_wait4="undef" +$ d_index="undef" +$ sig_name="ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM ABRT USR1 USR2"",0" +$ psnwc1="""ZERO"",""HUP"",""INT"",""QUIT"",""ILL"",""TRAP"",""IOT"",""EMT"",""FPE"",""KILL"",""BUS"",""SEGV"",""SYS""," +$ psnwc2="""PIPE"",""ALRM"",""TERM"",""ABRT"",""USR1"",""USR2"",0" +$ sig_name_init = psnwc1 + psnwc2 +$ sig_num="0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 6 16 17"",0" +$ sig_num_init="0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,6,16,17,0" +$! perl_sig_num_with_commas=sig_num_init +$ uidtype="unsigned int" +$ d_pathconf="undef" +$ d_fpathconf="undef" +$ d_sysconf="undef" +$ d_sigsetjmp="undef" +$ ENDIF +$! +$ IF d_gethname .EQS. "undef" .AND. d_uname .EQS. "undef" +$ THEN +$ d_phostname="define" +$ ELSE +$ d_phostname="undef" +$ ENDIF +$! +$! Dec C alone +$ IF ccname .EQS. "DEC" +$ THEN +$ d_mbstowcs="define" +$ d_mbtowc="define" +$ d_stdiobase="define" +$ d_stdio_cnt_lval="define" +$ d_stdio_ptr_lval="define" +$ d_stdstdio="define" +$ d_wcstombs="define" +$ d_mblen="define" +$ d_mktime="define" +$ d_strcoll="define" +$ d_strxfrm="define" +$ d_wctomb="define" +$ i_locale="define" +$ d_locconv="define" +$ d_setlocale="define" +$ vms_cc_type="decc" +$ ELSE +$ d_mbstowcs="undef" +$ d_mbtowc="undef" +$ d_stdiobase="undef" +$ d_stdio_cnt_lval="undef" +$ d_stdio_ptr_lval="undef" +$ d_stdstdio="undef" +$ d_wcstombs="undef" +$ d_mblen="undef" +$ d_mktime="undef" +$ d_strcoll="undef" +$ d_strxfrm="undef" +$ d_wctomb="undef" +$ i_locale="undef" +$ d_locconv="undef" +$ d_setlocale="undef" +$ ENDIF +$ d_stdio_ptr_lval_sets_cnt="undef" +$ d_stdio_ptr_lval_nochange_cnt="undef" +$! +$! Sockets? +$ if Has_Socketshr .OR. Has_Dec_C_Sockets +$ THEN +$ d_vms_do_sockets="define" +$ d_htonl="define" +$ d_socket="define" +$ d_select="define" +$ netdb_hlen_type="int" +$ netdb_host_type="char *" +$ netdb_name_type="char *" +$ netdb_net_type="long" +$ d_gethbyaddr="define" +$ d_gethbyname="define" +$ d_getnbyaddr="define" +$ d_getnbyname="define" +$ d_getpbynumber="define" +$ d_getpbyname="define" +$ d_getsbyport="define" +$ d_getsbyname="define" +$ d_gethostprotos="define" +$ d_getnetprotos="define" +$ d_getprotoprotos="define" +$ d_getservprotos="define" +$ IF ccname .EQS. "DEC" .OR. ccname .EQS. "CXX" +$ THEN +$ socksizetype="unsigned int" +$ ELSE +$ socksizetype="int *" +$ ENDIF +$ ELSE +$ d_vms_do_sockets="undef" +$ d_htonl="undef" +$ d_socket="undef" +$ d_select="undef" +$ netdb_hlen_type="int" +$ netdb_host_type="char *" +$ netdb_name_type="char *" +$ netdb_net_type="long" +$ d_gethbyaddr="undef" +$ d_gethbyname="undef" +$ d_getnbyaddr="undef" +$ d_getnbyname="undef" +$ d_getpbynumber="undef" +$ d_getpbyname="undef" +$ d_getsbyport="undef" +$ d_getsbyname="undef" +$ d_gethostprotos="undef" +$ d_getnetprotos="undef" +$ d_getprotoprotos="undef" +$ d_getservprotos="undef" +$ socksizetype="undef" +$ ENDIF +$! Threads +$ IF use_threads +$ THEN +$ usethreads="define" +$ d_pthreads_created_joinable="define" +$ if (vms_ver .GES. "7.0") +$ THEN +$ d_oldpthreads="undef" +$ ELSE +$ d_oldpthreads="define" +$ ENDIF +$ ELSE +$ d_oldpthreads="undef" +$ usethreads="undef" +$ d_pthreads_created_joinable="undef" +$ ENDIF +$! +$! new (5.005_62++) typedefs for primitives +$! +$ echo "Choosing the C types to be used for Perl's internal types..." +$ ivtype="long" +$ uvtype="unsigned long" +$ i8type="char" +$ u8type="unsigned char" +$ i16type="short" +$ u16type="unsigned short" +$ i32type="int" +$ u32type="unsigned int" +$ i64type="long long" +$ u64type="unsigned long long" +$ nvtype="double" +$! +$ IF use64bitint .OR. use64bitint .EQS. "define" +$ THEN +$ ivtype = "''i64type'" +$ uvtype = "''u64type'" +$ nvtype="long double" +$ ELSE +$ i64size="undef" +$ u64size="undef" +$ ENDIF +$! +$ tmp = "''ivtype'" +$ GOSUB type_size_check +$ ivsize = tmp +$ IF use64bitint .OR. use64bitint .EQS. "define" THEN i64size = tmp +$ IF ivtype .eqs. "long" +$ THEN longsize = tmp +$ ELSE +$ tmp = "long" +$ GOSUB type_size_check +$ longsize = tmp +$ ENDIF +$! +$ tmp = "''uvtype'" +$ GOSUB type_size_check +$ uvsize = tmp +$ IF use64bitint .OR. use64bitint .EQS. "define" THEN u64size = tmp +$! +$ tmp = "''i8type'" +$ GOSUB type_size_check +$ i8size = tmp +$! +$ tmp = "''u8type'" +$ GOSUB type_size_check +$ u8size = tmp +$! +$ tmp = "''i16type'" +$ GOSUB type_size_check +$ i16size = tmp +$ IF i16type .eqs. "short" +$ THEN shortsize = tmp +$ ELSE +$ tmp = "short" +$ gosub type_size_check +$ shortsize = tmp +$ ENDIF +$! +$ tmp = "''u16type'" +$ GOSUB type_size_check +$ u16size = tmp +$! +$ tmp = "''i32type'" +$ GOSUB type_size_check +$ i32size = tmp +$ IF i32type .eqs. "int" +$ THEN intsize = tmp +$ ELSE +$ tmp = "int" +$ gosub type_size_check +$ intsize = tmp +$ ENDIF +$! +$ tmp = "''u32type'" +$ gosub type_size_check +$ u32size = tmp +$! +$ tmp = "''nvtype'" +$ GOSUB type_size_check +$ nvsize = tmp +$! +$ echo "(IV will be ""''ivtype'"", ''ivsize' bytes)" +$ echo "(UV will be ""''uvtype'"", ''uvsize' bytes)" +$ echo "(NV will be ""''nvtype'"", ''nvsize' bytes)" +$! +$ echo4 "Checking whether your NVs can preserve your UVs..." +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main() {" +$ WS " ''uvtype' k = (''uvtype')~0, l;" +$ WS " ''nvtype' d;" +$ WS " l = k;" +$ WS " d = (''nvtype')l;" +$ WS " l = (''uvtype')d;" +$ WS " if (l == k)" +$ WS " printf(""preserve\n"");" +$ WS " exit(0);" +$ WS "}" +$ CS +$ GOSUB compile +$ IF tmp .EQS. "preserve" +$ THEN +$ d_nv_preserves_uv = "define" +$ echo "Yes, they can." +$ d_nv_preserves_uv_bits = F$STRING(F$INTEGER(uvsize) * 8) +$ ELSE +$ d_nv_preserves_uv = "undef" +$ echo "No, they can't." +$ echo4 "Checking how many bits of your UVs your NVs can preserve..." +$ OS +$ WS "#if defined(__DECC) || defined(__DECCXX)" +$ WS "#include " +$ WS "#endif" +$ WS "#include " +$ WS "int main() {" +$ WS " ''uvtype' u = 0;" +$ WS " int n = 8 * ''uvsize';" +$ WS " int i;" +$ WS " for (i = 0; i < n; i++) {" +$ WS " u = u << 1 | (''uvtype')1;" +$ WS " if ((''uvtype')(''nvtype')u != u)" +$ WS " break;" +$ WS " }" +$ WS " printf(""%d\n"", i);" +$ WS " exit(0);" +$ WS "}" +$ GOSUB compile +$ d_nv_preserves_uv_bits = tmp +$ ENDIF +$ DELETE/SYMBOL tmp +$! +$ ivdformat="""ld""" +$ uvuformat="""lu""" +$ uvoformat="""lo""" +$ uvxformat="""lx""" +$ uvXUformat="""lX""" +$! uselongdouble? +$ nveformat="""e""" +$ nvfformat="""f""" +$ nvgformat="""g""" +$! +$! Finally the composite ones. All config +$! +$ myuname="''osname' ''myname' ''osvers' ''F$EDIT(hwname, "TRIM")'" +$! +$ IF ccname .EQS. "DEC" +$ THEN +$ ccflags="/Include=[]/Standard=Relaxed_ANSI/Prefix=All/Obj=''obj_ext'/NoList''ccflags'" +$ ENDIF +$ i_dirent = "undef" +$ IF ccname .EQS. "CXX" +$ THEN +$ i_dirent = "define" +$ ccflags="/Include=[]/Standard=ANSI/Prefix=All/Obj=''obj_ext'/NoList''ccflags'" +$ ENDIF +$ IF use_vmsdebug_perl +$ THEN +$ optimize="/Debug/NoOpt" +$ ldflags="/Debug/Trace/Map" +$ dbgprefix = "DBG" +$ ELSE +$ optimize= "" +$ ldflags="/NoTrace/NoMap" +$ dbgprefix = "" +$ ENDIF +$! +$! Okay, we've got everything configured. Now go write out a config.sh. +$ basename_config_sh = F$PARSE(config_sh,,,"NAME",)+F$PARSE(config_sh,,,"TYPE",) +$ echo4 "Creating ''basename_config_sh'..." +$ open/write CONFIG 'config_sh' +$ WC := write CONFIG +$! +$! ##BEGIN WRITE NEW CONSTANTS HERE## +$! +$ WC "#!/bin/sh" +$ WC "#" +$ WC "# This file was produced by Configure.COM on a ''osname' system." +$ WC "#" +$ WC "# Package name : ''package'" +$ WC "# Source directory : ''src'" +$ WC "# Configuration time: " + cf_time +$ WC "# Configuration by : " + cf_by +$ WC "# Target system : " + myuname +$ WC "" +$ WC "CONFIG='true'" +$ WC "Makefile_SH='" + Makefile_SH + "'" +$ WC "Mcc='" + Mcc + "'" +$ WC "PERL_REVISION='" + revision + "'" +$ WC "PERL_VERSION='" + patchlevel + "'" +$ WC "PERL_SUBVERSION='" + subversion + "'" +$ WC "PERL_API_VERSION='" + api_version + "'" +$ WC "PERL_API_SUBVERSION='" + api_subversion + "'" +$ WC "alignbytes='" + alignbytes + "'" +$ WC "aphostname='write sys$output f$edit(f$getsyi(\""SCSNODE\""),\""TRIM,LOWERCASE\"")'" +$ WC "ar='" + "'" +$ WC "archlib='" + archlib + "'" +$ WC "archlibexp='" + archlibexp + "'" +$ WC "archname='" + archname + "'" +$ WC "baserev='" + baserev + "'" +$ WC "bin='" + bin + "'" +$ WC "binexp='" + binexp + "'" +$ WC "builddir='" + builddir + "'" +$ WC "byteorder='1234'" +$ WC "castflags='0'" +$ WC "cc='" + perl_cc + "'" +$ WC "cccdlflags='" + cccdlflags + "'" +$ WC "ccdlflags='" + ccdlflags + "'" +$ WC "ccflags='" + ccflags + "'" +$ WC "ccname='" + ccname + "'" +$ WC "ccversion='" + ccversion + "'" +$ WC "cf_by='" + cf_by + "'" +$ WC "cf_email='" + cf_email + "'" +$ WC "cf_time='" + cf_time + "'" +$ WC "config_args='" + config_args + "'" +$ WC "config_sh='" + config_sh + "'" +$ WC "cpp_stuff='" + cpp_stuff + "'" +$ WC "cpplast='" + cpplast + "'" +$ WC "cppminus='" + cppminus + "'" +$ WC "cpprun='" + cpprun + "'" +$ WC "cppstdin='" + cppstdin + "'" +$ WC "crosscompile='undef'" +$ WC "d__fwalk='undef'" +$ WC "d_Gconvert='my_gconvert(x,n,t,b)'" +$ WC "d_PRId64='" + d_PRId64 + "'" +$ WC "d_PRIEldbl='" + d_PRIEUldbl + "'" +$ WC "d_PRIFldbl='" + d_PRIFUldbl + "'" +$ WC "d_PRIGldbl='" + d_PRIGUldbl + "'" +$ WC "d_PRIX64='" + d_PRIXU64 + "'" +$ WC "d_PRIeldbl='" + d_PRIeldbl + "'" +$ WC "d_PRIfldbl='" + d_PRIfldbl + "'" +$ WC "d_PRIgldbl='" + d_PRIgldbl + "'" +$ WC "d_PRIo64='" + d_PRIo64 + "'" +$ WC "d_PRIu64='" + d_PRIu64 + "'" +$ WC "d_PRIx64='" + d_PRIx64 + "'" +$ WC "d_SCNfldbl='" + d_SCNfldbl + "'" +$ WC "d_access='" + d_access + "'" +$ WC "d_accessx='undef'" +$ WC "d_alarm='define'" +$ WC "d_archlib='define'" +$ WC "d_atolf='" + d_atolf + "'" +$ WC "d_atoll='" + d_atoll + "'" +$ WC "d_attribut='" + d_attribut + "'" +$ WC "d_bcmp='" + d_bcmp + "'" +$ WC "d_bcopy='" + d_bcopy + "'" +$ WC "d_bincompat3='undef'" +$ WC "d_bincompat5005='undef'" +$ WC "d_bsdgetpgrp='undef'" +$! WC "d_bsdpgrp='undef'" +$ WC "d_bsdsetpgrp='undef'" +$ WC "d_bzero='" + d_bzero + "'" +$ WC "d_casti32='define'" +$ WC "d_castneg='define'" +$ WC "d_charvspr='undef'" +$ WC "d_chown='define'" +$ WC "d_chroot='undef'" +$ WC "d_chsize='undef'" +$ WC "d_cmsghdr_s='undef'" +$ WC "d_const='define'" +$ WC "d_crypt='define'" +$ WC "d_csh='undef'" +$ WC "d_cuserid='define'" +$ WC "d_dbl_dig='define'" +$ WC "d_difftime='define'" +$ WC "d_dirnamlen='define'" +$ WC "d_dlerror='undef'" +$ WC "d_dlsymun='undef'" +$ WC "d_dosuid='undef'" +$ WC "d_drand48proto='" + d_drand48proto + "'" +$ WC "d_dup2='define'" +$ WC "d_eaccess='undef'" +$ WC "d_endgrent='define'" +$ WC "d_endhent='" + d_endhent + "'" +$ WC "d_endnent='" + d_endnent + "'" +$ WC "d_endpent='" + d_endpent + "'" +$ WC "d_endpwent='define'" +$ WC "d_endsent='" + d_endsent + "'" +$ WC "d_eofnblk='undef'" +$ WC "d_eunice='undef'" +$ WC "d_fchmod='undef'" +$ WC "d_fchown='undef'" +$ WC "d_fcntl='" + d_fcntl + "'" +$ WC "d_fcntl_can_lock='" + d_fcntl_can_lock + "'" +$ WC "d_fd_set='" + d_fd_set + "'" +$ WC "d_fgetpos='define'" +$ WC "d_flexfnam='define'" +$ WC "d_flock='undef'" +$ WC "d_fork='undef'" +$ WC "d_fpathconf='" + d_fpathconf + "'" +$ WC "d_fpos64_t='" + d_fpos64_t + "'" +$ WC "d_frexpl='" + d_frexpl + "'" +$ WC "d_fs_data_s='undef'" +$ WC "d_fseeko='undef'" +$ WC "d_fsetpos='define'" +$ WC "d_fstatfs='undef'" +$ WC "d_fstatvfs='undef'" +$ WC "d_fsync='undef'" +$ WC "d_ftello='undef'" +$ WC "d_getcwd='undef'" +$ WC "d_getespwnam='undef'" +$ WC "d_getfsstat='undef'" +$ WC "d_getgrent='define'" +$ WC "d_getgrps='undef'" +$ WC "d_gethbyaddr='" + d_gethbyaddr + "'" +$ WC "d_gethbyname='" + d_gethbyname + "'" +$ WC "d_gethent='" + d_gethent + "'" +$ WC "d_gethname='" + d_gethname + "'" +$ WC "d_gethostprotos='" + d_gethostprotos + "'" +$ WC "d_getlogin='define'" +$ WC "d_getmnt='undef'" +$ WC "d_getmntent='undef'" +$ WC "d_getnbyaddr='" + d_getnbyaddr + "'" +$ WC "d_getnbyname='" + d_getnbyname + "'" +$ WC "d_getnent='" + d_getnent + "'" +$ WC "d_getnetprotos='" + d_getnetprotos + "'" +$ WC "d_getpagsz='undef'" +$ WC "d_getpbyname='" + d_getpbyname + "'" +$ WC "d_getpbynumber='" + d_getpbynumber + "'" +$ WC "d_getpent='" + d_getpent + "'" +$ WC "d_getpgid='undef'" +$ WC "d_getpgrp2='undef'" +$ WC "d_getpgrp='undef'" +$ WC "d_getppid='undef'" +$ WC "d_getprior='undef'" +$ WC "d_getprotoprotos='" + d_getprotoprotos + "'" +$ WC "d_getprpwnam='undef'" +$ WC "d_getpwent='define'" +$ WC "d_getsbyname='" + d_getsbyname + "'" +$ WC "d_getsbyport='" + d_getsbyport + "'" +$ WC "d_getsent='" + d_getsent + "'" +$ WC "d_getservprotos='" + d_getservprotos + "'" +$ WC "d_getspnam='undef'" +$ WC "d_gettimeod='" + d_gettimeod + "'" +$ WC "d_gnulibc='undef'" +$ WC "d_grpasswd='undef'" +$ WC "d_hasmntopt='undef'" +$ WC "d_htonl='" + d_htonl + "'" +$ WC "d_iconv='" + d_iconv +"'" +$ WC "d_index='" + d_index + "'" +$ WC "d_inetaton='undef'" +$ WC "d_int64_t='" + d_int64_t + "'" +$ WC "d_isascii='define'" +$ WC "d_isnan='" + d_isnan + "'" +$ WC "d_isnanl='" + d_isnanl + "'" +$ WC "d_killpg='undef'" +$ WC "d_lchown='undef'" +$ WC "d_ldbl_dig='define'" +$ WC "d_link='undef'" +$ WC "d_llseek='undef'" +$ WC "d_locconv='" + d_locconv + "'" +$ WC "d_lockf='undef'" +$ WC "d_longdbl='" + d_longdbl + "'" +$ WC "d_longlong='" + d_longlong + "'" +$ WC "d_lseekproto='define'" +$ WC "d_lstat='undef'" +$ WC "d_madvise='undef'" +$ WC "d_mblen='" + d_mblen + "'" +$ WC "d_mbstowcs='" + d_mbstowcs + "'" +$ WC "d_mbtowc='" + d_mbtowc + "'" +$ WC "d_memchr='" + d_memchr + "'" +$ WC "d_memcmp='define'" +$ WC "d_memcpy='define'" +$ WC "d_memmove='define'" +$ WC "d_memset='define'" +$ WC "d_mkdir='define'" +$ WC "d_mkdtemp='" + d_mkdtemp + "'" +$ WC "d_mkfifo='undef'" +$ WC "d_mknod='undef'" +$ WC "d_mkstemp='" + d_mkstemp + "'" +$ WC "d_mkstemps='" + d_mkstemps + "'" +$ WC "d_mktime='" + d_mktime + "'" +$ WC "d_mmap='undef'" +$ WC "d_modfl='" + d_modfl + "'" +$ WC "d_mprotect='undef'" +$ WC "d_msg='undef'" +$ WC "d_msg_ctrunc='undef'" +$ WC "d_msg_dontroute='undef'" +$ WC "d_msg_oob='undef'" +$ WC "d_msg_peek='undef'" +$ WC "d_msg_proxy='undef'" +$ WC "d_msghdr_s='undef'" +$ WC "d_msync='undef'" +$ WC "d_munmap='undef'" +$ WC "d_mymalloc='" + d_mymalloc + "'" +$ WC "d_nice='define'" +$ WC "d_nv_preserves_uv='" + d_nv_preserves_uv + "'" +$ WC "d_nv_preserves_uv_bits='" + d_nv_preserves_uv_bits + "'" +$ WC "d_off64_t='" + d_off64_t + "'" +$ WC "d_old_pthread_create_joinable='" + d_old_pthread_create_joinable + "'" +$ WC "d_oldarchlib='define'" +$ WC "d_oldpthreads='" + d_oldpthreads + "'" +$ WC "d_open3='define'" +$ WC "d_pathconf='" + d_pathconf + "'" +$ WC "d_pause='define'" +$ WC "d_perl_otherlibdirs='undef'" +$ WC "d_phostname='" + d_phostname + "'" +$ WC "d_pipe='define'" +$ WC "d_poll='undef'" +$ WC "d_pthread_yield='" + d_pthread_yield + "'" +$ WC "d_pthreads_created_joinable='" + d_pthreads_created_joinable + "'" +$ WC "d_pwage='undef'" +$ WC "d_pwchange='undef'" +$ WC "d_pwclass='undef'" +$ WC "d_pwcomment='define'" +$ WC "d_pwexpire='undef'" +$ WC "d_pwgecos='define'" +$ WC "d_pwpasswd='define'" +$ WC "d_pwquota='undef'" +$ WC "d_qgcvt='undef'" +$ WC "d_quad='" + d_quad + "'" +$ WC "d_readdir='define'" +$ WC "d_readlink='undef'" +$ WC "d_readv='undef'" +$ WC "d_recvmsg='undef'" +$ WC "d_rename='define'" +$ WC "d_rewinddir='define'" +$ WC "d_rmdir='define'" +$ WC "d_safebcpy='undef'" +$ WC "d_safemcpy='define'" +$ WC "d_sanemcmp='define'" +$ WC "d_sbrkproto='define'" +$ WC "d_sched_yield='" + d_sched_yield + "'" +$ WC "d_scm_rights='undef'" +$ WC "d_seekdir='define'" +$ WC "d_select='" + d_select + "'" +$ WC "d_sem='undef'" +$ WC "d_semctl_semid_ds='undef'" +$ WC "d_semctl_semun='undef'" +$ WC "d_sendmsg='undef'" +$ WC "d_setegid='undef'" +$ WC "d_setenv='" + d_setenv + "'" +$ WC "d_seteuid='undef'" +$ WC "d_setgrent='undef'" +$ WC "d_setgrps='undef'" +$ WC "d_sethent='" + d_sethent + "'" +$ WC "d_setlinebuf='undef'" +$ WC "d_setlocale='" + d_setlocale + "'" +$ WC "d_setnent='" + d_setnent + "'" +$ WC "d_setpent='" + d_setpent + "'" +$ WC "d_setpgid='undef'" +$ WC "d_setpgrp2='undef'" +$ WC "d_setpgrp='undef'" +$ WC "d_setprior='undef'" +$ WC "d_setproctitle='" + d_setproctitle + "'" +$ WC "d_setpwent='define'" +$ WC "d_setregid='undef'" +$ WC "d_setresgid='undef'" +$ WC "d_setresuid='undef'" +$ WC "d_setreuid='undef'" +$ WC "d_setrgid='undef'" +$ WC "d_setruid='undef'" +$ WC "d_setsent='" + d_setsent + "'" +$ WC "d_setsid='undef'" +$ WC "d_setvbuf='" + d_setvbuf + "'" +$ WC "d_sfio='undef'" +$ WC "d_shm='undef'" +$ WC "d_shmatprototype='undef'" +$ WC "d_sigaction='" + d_sigaction + "'" +$ WC "d_sigsetjmp='" + d_sigsetjmp + "'" +$ WC "d_socket='" + d_socket + "'" +$ WC "d_socklen_t='" + d_socklen_t + "'" +$ WC "d_sockpair='undef'" +$ WC "d_socks5_init='undef'" +$ WC "d_sqrtl='define'" +$ WC "d_statblks='undef'" +$ WC "d_statfs_f_flags='undef'" +$ WC "d_statfs_s='undef'" +$ WC "d_statfsflags='undef'" +$ WC "d_stdio_cnt_lval='" + d_stdio_cnt_lval + "'" +$ WC "d_stdio_ptr_lval='" + d_stdio_ptr_lval + "'" +$ WC "d_stdio_ptr_lval_sets_cnt='" + d_stdio_ptr_lval_sets_cnt + "'" +$ WC "d_stdio_ptr_lval_nochange_cnt='" + d_stdio_ptr_lval_nochange_cnt + "'" +$ WC "d_stdio_stream_array='undef'" +$ WC "d_stdiobase='" + d_stdiobase + "'" +$ WC "d_stdstdio='" + d_stdstdio + "'" +$ WC "d_strchr='define'" +$ WC "d_strcoll='" + d_strcoll + "'" +$ WC "d_strctcpy='define'" +$ WC "d_strerrm='strerror((e),vaxc$errno)'" +$ WC "d_strerror='define'" +$ WC "d_strtod='define'" +$ WC "d_strtol='define'" +$ WC "d_strtold='" + d_strtold + "'" +$ WC "d_strtoll='" + d_strtoll + "'" +$ WC "d_strtoul='define'" +$ WC "d_strtoull='" + d_strtoull + "'" +$ WC "d_strtouq='" + d_strtouq + "'" +$ WC "d_strxfrm='" + d_strxfrm + "'" +$ WC "d_suidsafe='undef'" +$ WC "d_symlink='undef'" +$ WC "d_syscall='undef'" +$ WC "d_sysconf='" + d_sysconf + "'" +$ WC "d_syserrlst='undef'" +$ WC "d_system='define'" +$ WC "d_tcgetpgrp='undef'" +$ WC "d_tcsetpgrp='undef'" +$ WC "d_telldir='define'" +$ WC "d_telldirproto='define'" +$ WC "d_times='define'" +$ WC "d_truncate='" + d_truncate + "'" +$ WC "d_tzname='undef'" +$ WC "d_umask='define'" +$ WC "d_uname='" + d_uname + "'" +$ WC "d_union_semun='undef'" +$ WC "d_unlink_all_versions='undef'" +$ WC "d_ustat='undef'" +$ WC "d_vendorarch='undef'" +$ WC "d_vendorlib='undef'" +$ WC "d_vfork='define'" +$ WC "d_vms_case_sensitive_symbols='" + d_vms_be_case_sensitive + "'" ! VMS +$ WC "d_vms_do_sockets='" + d_vms_do_sockets + "'" ! VMS +$ WC "d_void_closedir='define'" +$ WC "d_volatile='define'" +$ WC "d_vprintf='define'" +$ WC "d_wait4='" + d_wait4 + "'" +$ WC "d_waitpid='define'" +$ WC "d_wcstombs='" + d_wcstombs + "'" +$ WC "d_wctomb='" + d_wctomb + "'" +$ WC "d_writev='undef'" +$ WC "db_hashtype=' '" +$ WC "db_prefixtype=' '" +$ WC "dbgprefix='" + dbgprefix + "'" +$ WC "defvoidused='15'" +$ WC "devtype='" + devtype + "'" +$ WC "direntrytype='struct dirent'" +$ WC "dlext='" + dlext + "'" +$ WC "dlobj='" + dlobj + "'" +$ WC "dlsrc='dl_vms.c'" +$ WC "doublesize='" + doublesize + "'" +$ WC "drand01='" + drand01 + "'" +$ WC "dynamic_ext='" + extensions + "'" +$ WC "eagain=' '" +$ WC "ebcdic='undef'" +$ WC "embedmymalloc='" + mymalloc + "'" +$ WC "eunicefix=':'" +$ WC "exe_ext='" + exe_ext + "'" +$ WC "extensions='" + extensions + "'" +$ WC "fflushNULL='define'" +$ WC "fflushall='undef'" +$ WC "fpostype='fpos_t'" +$ WC "freetype='void'" +$ WC "full_ar='" + "'" +$ WC "full_csh='" + " '" +$ WC "full_sed='_NLA0:'" +$ WC "gccversion='" + gccversion + "'" +$ WC "gidformat='lu'" +$ WC "gidsign='1'" +$ WC "gidsize='4'" +$ WC "gidtype='" + gidtype + "'" +$ WC "groupstype='Gid_t'" +$ WC "hint='none'" +$ WC "hintfile='" + "'" +$ WC "i16size='" + i16size + "'" +$ WC "i16type='" + i16type + "'" +$ WC "i32size='" + i32size + "'" +$ WC "i32type='" + i32type + "'" +$ WC "i64size='" + i64size + "'" +$ WC "i64type='" + i64type + "'" +$ WC "i8size='" + i8size + "'" +$ WC "i8type='" + i8type + "'" +$ WC "i_arpainet='undef'" +$ WC "i_dbm='undef'" +$ WC "i_dirent='" + i_dirent + "'" +$ WC "i_dlfcn='undef'" +$ WC "i_fcntl='" + i_fcntl + "'" +$ WC "i_float='define'" +$ WC "i_grp='undef'" +$ WC "i_iconv='" + i_iconv +"'" +$ WC "i_ieeefp='undef'" +$ WC "i_inttypes='" + i_inttypes + "'" +$ WC "i_libutil='" + i_libutil + "'" +$ WC "i_limits='define'" +$ WC "i_locale='" + i_locale + "'" +$ WC "i_machcthr='undef'" +$ WC "i_machcthreads='undef'" +$ WC "i_math='define'" +$ WC "i_memory='undef'" +$ WC "i_mntent='undef'" +$ WC "i_ndbm='undef'" +$ WC "i_netdb='" + i_netdb + "'" +$ WC "i_neterrno='define'" +$ WC "i_netinettcp='" + i_netinettcp + "'" +$ WC "i_niin='" + i_niin + "'" +$ WC "i_poll='" + i_poll + "'" +$ WC "i_prot='undef'" +$ WC "i_pthread='define'" +$ WC "i_pwd='undef'" +$ WC "i_rpcsvcdbm='undef'" +$ WC "i_sfio='undef'" +$ WC "i_sgtty='undef'" +$ WC "i_shadow='" + i_shadow + "'" +$ WC "i_socks='" + i_socks + "'" +$ WC "i_stdarg='define'" +$ WC "i_stddef='define'" +$ WC "i_stdlib='define'" +$ WC "i_string='define'" +$ WC "i_sunmath='undef'" +$ WC "i_sysaccess='" + i_sysaccess + "'" +$ WC "i_sysdir='undef'" +$ WC "i_sysfile='" + i_sysfile + "'" +$ WC "i_sysioctl='undef'" +$ WC "i_syslog='" + i_syslog + "'" +$ WC "i_sysmman='undef'" +$ WC "i_sysmode='" + i_sysmode + "'" +$ WC "i_sysmount='undef'" +$ WC "i_sysndir='undef'" +$ WC "i_sysparam='undef'" +$ WC "i_sysresrc='undef'" +$ WC "i_syssecrt='" + i_syssecrt + "'" +$ WC "i_sysselct='undef'" +$ WC "i_sysstat='define'" +$ WC "i_sysstatfs='undef'" +$ WC "i_sysstatvfs='undef'" +$ WC "i_systime='undef'" +$ WC "i_systimek='undef'" +$ WC "i_systimes='undef'" +$ WC "i_systypes='define'" +$ WC "i_sysuio='" + i_sysuio + "'" +$ WC "i_sysun='undef'" +$ WC "i_sysutsname='" + i_sysutsname + "'" +$ WC "i_sysvfs='undef'" +$ WC "i_syswait='undef'" +$ WC "i_termio='undef'" +$ WC "i_termios='undef'" +$ WC "i_time='define'" +$ WC "i_unistd='" + i_unistd + "'" +$ WC "i_ustat='undef'" +$ WC "i_utime='undef'" +$ WC "i_values='undef'" +$ WC "i_varargs='undef'" +$ WC "i_vfork='undef'" +$ WC "inc_version_list='0'" +$ WC "inc_version_list_init='0'" +$ WC "installarchlib='" + installarchlib + "'" +$ WC "installbin='" + installbin + "'" +$ WC "installman1dir='" + installman1dir + "'" +$ WC "installman3dir='" + installman3dir + "'" +$ WC "installprivlib='" + installprivlib + "'" +$ WC "installscript='" + installscript + "'" +$ WC "installsitearch='" + installsitearch + "'" +$ WC "installsitelib='" + installsitelib + "'" +$ WC "installusrbinperl='undef'" +$ WC "intsize='" + intsize + "'" +$ WC "ivdformat='" + ivdformat + "'" +$ WC "ivsize='" + ivsize + "'" +$ WC "ivtype='" + ivtype + "'" +$ WC "known_extensions='" + known_extensions + "'" +$ WC "ld='" + ld + "'" +$ WC "lddlflags='/Share'" +$ WC "ldflags='" + ldflags + "'" +$ WC "lib_ext='" + lib_ext + "'" +$ WC "libc='" + libc + "'" +$ WC "libpth='/sys$share /sys$library'" +$ WC "libs='" + libs + "'" +$ WC "longdblsize='" + longdblsize + "'" +$ WC "longlongsize='" + longlongsize + "'" +$ WC "longsize='" + longsize + "'" +$ WC "lseeksize='4'" +$ WC "lseektype='int'" +$ WC "mab='" + "'" +$ WC "make='" + make + "'" +$ WC "malloctype='void *'" +$ WC "man1ext='rno'" +$ WC "man3ext='rno'" +$ WC "mmaptype=' " + "'" +$ WC "modetype='unsigned int'" +$ WC "multiarch='undef'" +$ WC "mydomain='" + mydomain + "'" +$ WC "myhostname='" + myhostname + "'" +$ WC "myuname='" + myuname + "'" +$ WC "netdb_hlen_type='" + netdb_hlen_type + "'" +$ WC "netdb_host_type='" + netdb_host_type + "'" +$ WC "netdb_name_type='" + netdb_name_type + "'" +$ WC "netdb_net_type='" + netdb_net_type + "'" +$ WC "nveformat='" + nveformat + "'" +$ WC "nvfformat='" + nvfformat + "'" +$ WC "nvgformat='" + nvgformat + "'" +$ WC "nvsize='" + nvsize + "'" +$ WC "nvtype='" + nvtype + "'" +$ WC "o_nonblock=' '" +$ WC "obj_ext='" + obj_ext + "'" +$ WC "old_pthread_create_joinable='" + old_pthread_create_joinable + "'" +$ WC "oldarchlib='" + oldarchlib + "'" +$ WC "oldarchlibexp='" + oldarchlibexp + "'" +$ WC "optimize='" + optimize + "'" +$ WC "osname='" + osname + "'" +$ WC "osvers='" + osvers + "'" +$ WC "otherlibdirs='" + "'" +$ WC "package='" + package + "'" +$ WC "pager='" + pager + "'" +$ WC "patchlevel='" + patchlevel + "'" +$ WC "path_sep='|'" +$ WC "perl_root='" + perl_root + "'" ! VMS specific $trnlnm() +$ WC "perladmin='" + perladmin + "'" +$ WC "perllibs='" + perllibs + "'" +$ WC "pgflquota='" + pgflquota + "'" +$ WC "pidtype='" + pidtype + "'" +$ WC "pm_apiversion='" + version + "'" +$! WC "prefix='" + vms_prefix + "'" +$ WC "prefix='" + prefix + "'" +$ WC "privlib='" + privlib + "'" +$ WC "privlibexp='" + privlibexp + "'" +$ WC "prototype='define'" +$ WC "ptrsize='" + ptrsize + "'" +$ WC "quadkind='" + quadkind + "'" +$ WC "quadtype='" + quadtype + "'" +$ WC "randbits='31'" +$ WC "randseedtype='" + randseedtype + "'" +$ WC "ranlib='" + "'" +$ WC "rd_nodata=' '" +$ WC "revision='" + revision + "'" +$ WC "sPRId64='" + sPRId64 + "'" +$ WC "sPRIEldbl='" + sPRIEUldbl + "'" +$ WC "sPRIFldbl='" + sPRIFUldbl + "'" +$ WC "sPRIGldbl='" + sPRIGUldbl + "'" +$ WC "sPRIX64='" + sPRIXU64 + "'" +$ WC "sPRIeldbl='" + sPRIeldbl + "'" +$ WC "sPRIfldbl='" + sPRIfldbl + "'" +$ WC "sPRIgldbl='" + sPRIgldbl + "'" +$! WC "sPRIi64='" + sPRIi64 + "'" +$ WC "sPRIo64='" + sPRIo64 + "'" +$ WC "sPRIu64='" + sPRIu64 + "'" +$ WC "sPRIx64='" + sPRIx64 + "'" +$ WC "sSCNfldbl='" + sSCNfldbl + "'" +$ WC "sched_yield='" + sched_yield + "'" +$ WC "seedfunc='" + seedfunc + "'" +$ WC "selectminbits='32'" +$ WC "selecttype='" + selecttype + "'" +$ WC "sh='MCR'" +$ WC "shmattype='" + " '" +$ WC "shortsize='" + shortsize + "'" +$ WC "shrplib='define'" +$ WC "sig_name='" + sig_name + "'" +$ tmp = "sig_name_init='" + sig_name_init + "'" +$ WC/symbol tmp +$ DELETE/SYMBOL tmp +$ WC "sig_num='" + sig_num + "'" +$ WC "sig_num_init='" + sig_num_init + "'" +$ WC "signal_t='" + signal_t + "'" +$ WC "sitearch='" + sitearch + "'" +$ WC "sitearchexp='" + sitearchexp + "'" +$ WC "sitelib='" + sitelib + "'" +$ WC "sitelib_stem='" + sitelib_stem + "'" +$ WC "sitelibexp='" + sitelibexp + "'" +$ WC "sizesize='" + sizesize + "'" +$ WC "sizetype='size_t'" +$ WC "so='" + so + "'" +$ WC "socksizetype='" + socksizetype + "'" +$ WC "spitshell='write sys$output '" +$ WC "src='" + src + "'" +$ WC "ssizetype='int'" +$ WC "startperl=" + startperl ! This one's special--no enclosing single quotes +$ WC "static_ext='" + static_ext + "'" +$ WC "stdchar='" + stdchar + "'" +$ WC "stdio_base='((*fp)->_base)'" +$ WC "stdio_bufsiz='((*fp)->_cnt + (*fp)->_ptr - (*fp)->_base)'" +$ WC "stdio_cnt='((*fp)->_cnt)'" +$ WC "stdio_ptr='((*fp)->_ptr)'" +$ WC "stdio_stream_array=' " + "'" +$ WC "subversion='" + subversion + "'" +$ WC "timetype='" + timetype + "'" +$ WC "u16size='" + u16size + "'" +$ WC "u16type='" + u16type + "'" +$ WC "u32size='" + u32size + "'" +$ WC "u32type='" + u32type + "'" +$ WC "u64size='" + u64size + "'" +$ WC "u64type='" + u64type + "'" +$ WC "u8size='" + u8size + "'" +$ WC "u8type='" + u8type + "'" +$ WC "uidformat='lu'" +$ WC "uidsign='1'" +$ WC "uidsize='4'" +$ WC "uidtype='" + uidtype + "'" +$ WC "uquadtype='" + uquadtype + "'" +$ WC "use5005threads='" + use5005threads + "'" +$ WC "use64bitall='" + use64bitall + "'" +$ WC "use64bitint='" + use64bitint + "'" +$ WC "usedebugging_perl='" + use_debugging_perl + "'" +$ WC "usedl='" + usedl + "'" +$ WC "useithreads='" + useithreads + "'" +$ WC "uselargefiles='" + uselargefiles + "'" +$ WC "uselongdouble='" + uselongdouble + "'" +$ WC "usemorebits='" + usemorebits + "'" +$ WC "usemultiplicity='" + usemultiplicity + "'" +$ WC "usemymalloc='" + usemymalloc + "'" +$ WC "useperlio='undef'" +$ WC "useposix='false'" +$ WC "usesocks='undef'" +$ WC "usethreads='" + usethreads + "'" +$ WC "usevfork='true'" +$ WC "uvoformat='" + uvoformat + "'" +$ WC "uvsize='" + uvsize + "'" +$ WC "uvtype='" + uvtype + "'" +$ WC "uvuformat='" + uvuformat + "'" +$ WC "uvxformat='" + uvxformat + "'" +$ WC "uvXUformat='" + uvXUformat + "'" +$ WC "vendorarchexp='" + "'" +$ WC "vendorlib_stem='" + "'" +$ WC "vendorlibexp='" + "'" +$ WC "version='" + version + "'" +$ WC "vms_cc_type='" + vms_cc_type + "'" ! VMS specific +$ WC "vms_prefix='" + vms_prefix + "'" ! VMS specific +$ WC "vms_ver='" + vms_ver + "'" ! VMS specific +$ WC "voidflags='15'" +$ WC "xs_apiversion='" + version + "'" +$ WC "CONFIGDOTSH='true'" +$! +$! ##END WRITE NEW CONSTANTS HERE## +$! +$ CLOSE CONFIG +$! +$! Okay, we've gotten here. Build munchconfig.exe +$ COPY/NOLOG [-.vms]munchconfig.c [] +$ COPY/NOLOG [-.vms]'Makefile_SH' [] +$ 'Perl_CC' munchconfig.c +$ IF Needs_Opt +$ THEN +$ OPEN/WRITE CONFIG []munchconfig.opt +$ IF ccname .EQS. "GCC" +$ THEN +$ WRITE CONFIG "Gnu_CC:[000000]gcclib.olb/library" +$ ENDIF +$ WRITE CONFIG "Sys$Share:VAXCRTL/Share" +$ CLOSE CONFIG +$ 'ld' munchconfig.obj,munchconfig.opt/opt +$ DELETE/NOLOG/NOCONFIRM munchconfig.opt; +$ ELSE +$ 'ld' munchconfig.obj +$ ENDIF +$ IF F$SEARCH("munchconfig.obj") .NES. "" THEN DELETE/NOLOG/NOCONFIRM munchconfig.obj; +$ IF F$SEARCH("munchconfig.c") .NES. "" THEN DELETE/NOLOG/NOCONFIRM munchconfig.c; +$ IF ccname .EQS. "CXX" +$ THEN +$ CALL Cxx_demangler_cleanup +$ ENDIF +$! +$ IF alldone .EQS. "" +$ THEN +$ cat4 SYS$INPUT: +$ DECK + +If you'd like to make any changes to the config.sh file before I begin +to configure things, answer yes to the following question. + +$ EOD +$ dflt="n" +$ rp="Do you wish to edit ''basename_config_sh'? [''dflt'] " +$ GOSUB myread +$ IF ans .EQS. "" then ans = dflt +$ IF ans +$ THEN +$ echo4 "" +$ echo4 "Be sure to type LOGOUT after you have edited the file," +$ echo4 "then this procedure will resume." +$ echo4 "" +$ default = F$ENVIRONMENT("DEFAULT") +$ DIRECTORY 'config_sh' +$ SET DEFAULT [-] +$ SPAWN/WAIT +$ SET DEFAULT 'default' +$ ENDIF +$ ENDIF +$! +$ echo "" +$ echo4 "Adding ''osname' specific preprocessor commands." +$ ! +$ ! we need an fdl file +$ CREATE [-]CONFIG.FDL +$ DECK +RECORD + FORMAT STREAM_LF +$ EOD +$ CREATE /FDL=[-]CONFIG.FDL [-]CONFIG.LOCAL +$ ! First spit out the header info with the local defines (to get +$ ! around the 255 character command line limit) +$ OPEN/APPEND CONFIG [-]config.local +$ IF use_debugging_perl THEN WC "#define DEBUGGING" +$ IF use_two_pot_malloc THEN WC "#define TWO_POT_OPTIMIZE" +$ IF mymalloc THEN WC "#define EMBEDMYMALLOC" +$ IF use_pack_malloc THEN WC "#define PACK_MALLOC" +$ IF use_debugmalloc THEN WC "#define DEBUGGING_MSTATS" +$ IF ccname .EQS. "GCC" THEN WC "#define GNUC_ATTRIBUTE_CHECK" +$ IF (Has_Dec_C_Sockets) +$ THEN +$ WC "#define VMS_DO_SOCKETS" +$ WC "#define DECCRTL_SOCKETS" +$ ELSE +$ IF Has_Socketshr THEN WC "#define VMS_DO_SOCKETS" +$ ENDIF +$! This is VMS-specific for now +$ WC "#''d_setenv' HAS_SETENV" +$ IF d_secintgenv THEN WC "#define SECURE_INTERNAL_GETENV" +$ IF d_alwdeftype THEN WC "#define ALWAYS_DEFTYPES" +$ IF use64bitint .OR. use64bitint .EQS. "define" +$ THEN +$ WC "#define USE_64_BIT_INT" +$ WC "#define USE_LONG_DOUBLE" +$ ENDIF +$ IF use64bitall .OR. use64bitall .EQS. "define" THEN - + WC "#define USE_64_BIT_ALL" +$ IF be_case_sensitive THEN WC "#define VMS_WE_ARE_CASE_SENSITIVE" +$ IF d_herrno .EQS. "undef" THEN WC "#define NEED_AN_H_ERRNO" +$ WC "#define HAS_ENVGETENV" +$ WC "#define PERL_EXTERNAL_GLOB" +$ CLOSE CONFIG +$! +$ echo4 "Doing variable substitutions on .SH files..." +$ echo4 "Extracting config.h (with variable substitutions)" +$! +$! Now build the normal config.h +$ DEFINE/USER_MODE sys$output [-]config.main +$ mcr []munchconfig 'config_sh' [-]config_h.sh +$ ! Concatenate them together +$ copy [-]config.local,[-]config.main [-]config.h +$! Clean up +$ DELETE/NOLOG [-]CONFIG.MAIN;* +$ DELETE/NOLOG [-]CONFIG.LOCAL;* +$ DELETE/NOLOG [-]CONFIG.FDL;* +$! +$ IF ccname .EQS. "DEC" +$ THEN +$ DECC_REPLACE = "DECC=decc=1" +$ ELSE +$ DECC_REPLACE = "DECC=" +$ ENDIF +$ IF ccname .EQS. "CXX" +$ THEN +$ DECCXX_REPLACE = "DECCXX=DECCXX=1" +$ ELSE +$ DECCXX_REPLACE = "DECCXX=" +$ ENDIF +$ IF ccname .EQS. "GCC" +$ THEN +$ GNUC_REPLACE = "GNUC=gnuc=1" +$ ELSE +$ GNUC_REPLACE = "GNUC=" +$ ENDIF +$ IF Has_Dec_C_Sockets +$ THEN +$ SOCKET_REPLACE = "SOCKET=DECC_SOCKETS=1" +$ ELSE +$ IF Has_Socketshr +$ THEN +$ SOCKET_REPLACE = "SOCKET=SOCKETSHR_SOCKETS=1" +$ ELSE +$ SOCKET_REPLACE = "SOCKET=" +$ ENDIF +$ ENDIF +$ IF Use_Threads +$ THEN +$ IF (vms_ver .LES. "6.2") +$ THEN +$ THREAD_REPLACE = "THREAD=OLDTHREADED=1" +$ ELSE +$ THREAD_REPLACE = "THREAD=THREADED=1" +$ ENDIF +$ ELSE +$ THREAD_REPLACE = "THREAD=" +$ ENDIF +$ IF mymalloc +$ THEN +$ MALLOC_REPLACE = "MALLOC=MALLOC=1" +$ ELSE +$ MALLOC_REPLACE = "MALLOC=" +$ ENDIF +$ echo4 "Extracting ''defmakefile' (with variable substitutions)" +$ DEFINE/USER_MODE sys$output 'UUmakefile' +$ mcr []munchconfig 'config_sh' 'Makefile_SH' "''DECC_REPLACE'" - + "''DECCXX_REPLACE'" "''ARCH_TYPE'" "''GNUC_REPLACE'" "''SOCKET_REPLACE'" - + "''THREAD_REPLACE'" "''C_Compiler_Replace'" "''MALLOC_REPLACE'" - + "''Thread_Live_Dangerously'" "PV=''version'" "FLAGS=FLAGS=''extra_flags'" +$! Clean up after ourselves +$ DELETE/NOLOG/NOCONFIRM []munchconfig.exe; +$ echo4 "Extracting make_ext.com (without variable substitutions)" +$ Create Sys$Disk:[-]make_ext.com +$ Deck/Dollar="$EndOfTpl$" +$!++ make_ext.com +$! NOTE: This file is extracted as part of the VMS configuration process. +$! Any changes made to it directly will be lost. If you need to make any +$! changes, please edit the template in Configure.Com instead. +$ def = F$Environment("Default") +$ exts1 = F$Edit(p1,"Compress") +$ p2 = F$Edit(p2,"Upcase,Compress,Trim") +$ If F$Locate("MCR ",p2).eq.0 Then p2 = F$Extract(3,255,p2) +$ miniperl = "$" + F$Search(F$Parse(p2,".Exe")) +$ makeutil = p3 +$ if f$type('p3') .nes. "" then makeutil = 'p3' +$ targ = F$Edit(p4,"Lowercase") +$ i = 0 +$ next_ext: +$ ext = F$Element(i," ",p1) +$ If ext .eqs. " " Then Goto done +$ Define/User_mode Perl_Env_Tables CLISYM_LOCAL +$ miniperl +$ deck + ($extdir = $ENV{'ext'}) =~ s/::/./g; + $extdir =~ s#/#.#g; + if ($extdir =~ /^vms/i) { $extdir =~ s/vms/.vms.ext/i; } + else { $extdir = ".ext.$extdir"; } + ($ENV{'extdir'} = "[$extdir]"); + ($ENV{'up'} = ('-') x ($extdir =~ tr/././)); +$ eod +$ Set Default &extdir +$ redesc = 0 +$ If F$Locate("clean",targ) .eqs. F$Length(targ) +$ Then +$ Write Sys$Output "" +$ Write Sys$Output " Making ''ext' (dynamic)" +$ On Error Then Goto done +$ If F$Search("Descrip.MMS") .eqs. "" +$ Then +$ redesc = 1 +$ Else +$ If F$CvTime(F$File("Descrip.MMS","rdt")) .lts. - + F$CvTime(F$File("Makefile.PL","rdt")) Then redesc = 1 +$ EndIf +$ Else +$ Write Sys$Output "''targ'ing ''ext' . . ." +$ On Error Then Continue +$ EndIf +$ If redesc Then - + miniperl "-I[''up'.lib]" Makefile.PL "INST_LIB=[''up'.lib]" "INST_ARCHLIB=[''up'.lib]" +$ makeutil 'targ' +$ i = i + 1 +$ Set Def &def +$ Goto next_ext +$ done: +$ sts = $Status +$ Set Def &def +$ Exit sts +$!-- make_ext.com +$EndOfTpl$ +$! +$! Note that the /key qualifier to search, as in: +$! search README.* "=head"/key=(position=1)/window=0/output=extra.pods +$! is not supported on VMS V5.5-2, hence not used in extra_pods.com. +$! +$ echo4 "Extracting extra_pods.com (without variable substitutions)" +$ Create Sys$Disk:[-]extra_pods.com +$ Deck/Dollar="$EOExtra_Pods$" +$!++ extra_pods.com +$! NOTE: This file is extracted as part of the VMS configuration process. +$! Any changes made to it directly will be lost. If you need to make any +$! changes, please edit the template in Configure.Com instead. +$! Use FORCE if you've just podified a README.* file on VMS. +$ if f$search("extra.pods") .eqs. "" .or. P1 .eqs. "FORCE" then - + search README.* "=head"/window=0/output=extra.pods +$ open/read/error=extra_close EXTRA extra.pods +$extra_loop: +$ read/error=extra_close/END_OF_FILE=extra_close EXTRA file +$ file_type = f$parse(file,,,"TYPE",) - "." +$ if file_type .nes. "VMS" .and. file_type .nes. "vms" +$ then +$ pod_file = "[.pod]perl''file_type'.pod" +$ file = file - "''f$parse(file,,,"VERSION",)'" +$ if p1 .eqs. "CLEAN" +$ then if f$search(pod_file) .nes. "" then delete/log 'pod_file';* +$ else +$ do_copy := false +$ if f$search(pod_file) .eqs. "" +$ then do_copy := true +$ else +$ file_rdt = f$cvtime(f$file_attributes(file,"RDT")) +$ pod_file_rdt = f$cvtime(f$file_attributes(pod_file,"RDT")) +$ if file_rdt .GTS. pod_file_rdt then do_copy := true +$ endif +$ if do_copy then copy/log/noconfirm 'file' 'pod_file' +$ endif +$ endif +$ goto extra_loop +$extra_close: +$ close EXTRA +$ if p1 .eqs. "CLEAN" .and. f$search("extra.pods;-1") .nes. "" then - + purge/nolog extra.pods +$!-- extra_pods.com +$EOExtra_Pods$ $! $! Warn of dangerous symbols or logical names $! @@ -2206,7 +5644,7 @@ $Bad_environment: SUBROUTINE $ Bad_env = "" $ IF p2 .eqs. "SYMBOL" $ THEN -$ IF f$type('p1) .nes. "" THEN Bad_env := SYMBOL +$ IF f$type('p1') .nes. "" THEN Bad_env := SYMBOL $ ELSE $ IF f$trnlnm(p1) .nes. "" THEN Bad_env := LOGICAL $ ENDIF @@ -2226,7 +5664,7 @@ $ WRITE CONFIG " delete before building ''package' via:" $ WRITE CONFIG " $ DELETE/SYMBOL/GLOBAL ''p1'" $ IF f$locate("""",&p1) .ge. f$length(&p1) $ THEN -$ WRITE CONFIG " after building, testing, and installing ''package' +$ WRITE CONFIG " after building, testing, and installing ''package'" $ WRITE CONFIG " restore the symbol with:" $ WRITE CONFIG " $ ''p1' == """ + &p1 + """" $ ENDIF @@ -2243,7 +5681,7 @@ $ ENDIF $ EXIT $ ENDSUBROUTINE ! Bad_environment $ echo "" -$ echo4 "%Config-I-VMS, Checking for dangerous pre-existing global symbols and logical names." +$ echo4 "Checking for dangerous pre-existing global symbols and logical names." $ CALL Bad_environment "TMP" $ CALL Bad_environment "LIB" $ CALL Bad_environment "T" @@ -2258,28 +5696,28 @@ $ IF (.NOT.perl_symbol) $ THEN $ file_2_find = "[-]''packageup'.cld" $ echo "" -$ echo4 "%Config-I-VMS, The perl.cld file is now being written..." +$ echo4 "The perl.cld file is now being written..." $ OPEN/WRITE CONFIG 'file_2_find' $ ext = ".exe" -$ IF ((sharedperl) .AND. (f$getsyi("ARCH_NAME") .NES. "VAX")) THEN ext := .AXE +$ IF ((sharedperl) .AND. (F$GETSYI("HW_MODEL") .GE. 1024)) THEN ext := .AXE $ IF (use_vmsdebug_perl) $ THEN $ WRITE CONFIG "define verb dbgperl" -$ WRITE CONFIG F$FAO("!_!AS","image ''packageup'_root:[000000]dbgperl''ext'") +$ WRITE CONFIG F$FAO("!_!AS","image ''vms_prefix':[000000]dbgperl''ext'") $ WRITE CONFIG F$FAO("!_!AS","cliflags (foreign)") $ WRITE CONFIG "" $ WRITE CONFIG "define verb perl" -$ WRITE CONFIG F$FAO("!_!AS","image ''packageup'_root:[000000]ndbgPerl''ext'") +$ WRITE CONFIG F$FAO("!_!AS","image ''vms_prefix':[000000]ndbgPerl''ext'") $ WRITE CONFIG F$FAO("!_!AS","cliflags (foreign)") $ ELSE $ WRITE CONFIG "define verb perl" -$ WRITE CONFIG F$FAO("!_!AS","image ''packageup'_root:[000000]perl''ext'") +$ WRITE CONFIG F$FAO("!_!AS","image ''vms_prefix':[000000]perl''ext'") $ WRITE CONFIG F$FAO("!_!AS","cliflags (foreign)") $ ENDIF $ CLOSE CONFIG $ ENDIF ! (.NOT.perl_symbol) $ echo "" -$ echo4 "%Config-I-VMS, The perl_setup.com file is now being written..." +$ echo4 "The perl_setup.com file is now being written..." $ file_2_find = "[-]perl_setup.com" $ OPEN/WRITE CONFIG 'file_2_find' $ WRITE CONFIG "$!" @@ -2294,38 +5732,38 @@ $ WRITE CONFIG "$!" $ prefix = prefix - "000000." $ IF F$LOCATE(".]",prefix) .EQ. F$LENGTH(prefix) THEN - prefix = prefix - "]" + ".]" -$ WRITE CONFIG "$ define/translation=concealed Perl_Root ''prefix'" +$ WRITE CONFIG "$ define/translation=concealed ''vms_prefix' ''prefix'" $ WRITE CONFIG "$ ext = "".exe""" -$ IF sharedperl .EQS. "Y" +$ IF sharedperl $ THEN -$ write config "$ if f$getsyi(""ARCH_NAME"") .nes. ""VAX"" then ext = "".AXE""" +$ write config "$ if f$getsyi(""HW_MODEL"") .ge. 1024 then ext = "".AXE""" $ ENDIF $ IF (perl_symbol) $ THEN $ IF (use_vmsdebug_perl) $ THEN -$ WRITE CONFIG "$ dbgperl :== $Perl_Root:[000000]dbgPerl'ext'" -$ WRITE CONFIG "$ perl :== $Perl_Root:[000000]ndbgPerl'ext'" -$ WRITE CONFIG "$ define dbgPerlShr Perl_Root:[000000]dbgPerlShr'ext'" +$ WRITE CONFIG "$ dbgperl :== $''vms_prefix':[000000]dbgPerl'ext'" +$ WRITE CONFIG "$ perl :== $''vms_prefix':[000000]ndbgPerl'ext'" +$ WRITE CONFIG "$ define dbgPerlShr ''vms_prefix':[000000]dbgPerlShr'ext'" $ ELSE -$ WRITE CONFIG "$ perl :== $Perl_Root:[000000]Perl'ext'" -$ WRITE CONFIG "$ define PerlShr Perl_Root:[000000]PerlShr'ext'" +$ WRITE CONFIG "$ perl :== $''vms_prefix':[000000]Perl'ext'" +$ WRITE CONFIG "$ define PerlShr ''vms_prefix':[000000]PerlShr'ext'" $ ENDIF $ ELSE ! .NOT.perl_symbol $ IF (use_vmsdebug_perl) $ THEN -$ WRITE CONFIG "$ define dbgPerlShr Perl_Root:[000000]dbgPerlShr'ext'" +$ WRITE CONFIG "$ define dbgPerlShr ''vms_prefix':[000000]dbgPerlShr'ext'" $ ELSE -$ WRITE CONFIG "$ define PerlShr Perl_Root:[000000]PerlShr'ext'" +$ WRITE CONFIG "$ define PerlShr ''vms_prefix':[000000]PerlShr'ext'" $ ENDIF $ IF perl_verb .EQS. "PROCESS" $ THEN -$ WRITE CONFIG "$ set command ''packagup'_ROOT:[000000]''packageup'.CLD" +$ WRITE CONFIG "$ set command ''vms_prefix':[000000]''packageup'.CLD" $ ENDIF $ ENDIF ! perl_symbol -$ WRITE CONFIG "$ define/nolog pod2text Perl_Root:[lib.pod]pod2text.com" -$ WRITE CONFIG "$ define/nolog pod2html Perl_Root:[lib.pod]pod2html.com" -$ WRITE CONFIG "$ define/nolog pod2man Perl_Root:[lib.pod]pod2man.com" +$ WRITE CONFIG "$ define/nolog pod2text ''vms_prefix':[lib.pod]pod2text.com" +$ WRITE CONFIG "$ define/nolog pod2html ''vms_prefix':[lib.pod]pod2html.com" +$ WRITE CONFIG "$ define/nolog pod2man ''vms_prefix':[lib.pod]pod2man.com" $! $ IF (tzneedset) $ THEN @@ -2338,59 +5776,59 @@ $ WRITE CONFIG "$! Symbols for commonly used scripts:" $ WRITE CONFIG "$!" $ IF (perl_symbol) $ THEN -$ WRITE CONFIG "$ Perldoc == ""'"+"'Perl' Perl_Root:[lib.pod]Perldoc.com -t""" +$ WRITE CONFIG "$ Perldoc == ""'"+"'Perl' ''vms_prefix':[lib.pod]Perldoc.com -t""" $ WRITE CONFIG "$ pod2text == ""'"+"'Perl' pod2text""" $ WRITE CONFIG "$ pod2html == ""'"+"'Perl' pod2html""" -$ WRITE CONFIG "$ pod2latex == ""'"+"'Perl' Perl_Root:[lib.pod]pod2latex.com""" +$ WRITE CONFIG "$ pod2latex == ""'"+"'Perl' ''vms_prefix':[lib.pod]pod2latex.com""" $ WRITE CONFIG "$!pod2man == ""'"+"'Perl' pod2man""" -$ WRITE CONFIG "$!Perlbug == ""'"+"'Perl' Perl_Root:[lib]Perlbug.com""" -$ WRITE CONFIG "$ c2ph == ""'"+"'Perl' Perl_Root:[utils]c2ph.com""" +$ WRITE CONFIG "$!Perlbug == ""'"+"'Perl' ''vms_prefix':[lib]Perlbug.com""" +$ WRITE CONFIG "$ c2ph == ""'"+"'Perl' ''vms_prefix':[utils]c2ph.com""" $ IF F$LOCATE("Devel::DProf",extensions) .LT. F$LENGTH(extensions) $ THEN -$ WRITE CONFIG "$ dprofpp == ""'"+"'Perl' Perl_Root:[utils]dprofpp.com""" +$ WRITE CONFIG "$ dprofpp == ""'"+"'Perl' ''vms_prefix':[utils]dprofpp.com""" $ ENDIF -$ WRITE CONFIG "$ h2ph == ""'"+"'Perl' Perl_Root:[utils]h2ph.com""" -$ WRITE CONFIG "$ h2xs == ""'"+"'Perl' Perl_Root:[utils]h2xs.com""" -$ WRITE CONFIG "$!perlcc == ""'"+"'Perl' Perl_Root:[utils]perlcc.com""" -$ WRITE CONFIG "$ splain == ""'"+"'Perl' Perl_Root:[utils]splain.com""" +$ WRITE CONFIG "$ h2ph == ""'"+"'Perl' ''vms_prefix':[utils]h2ph.com""" +$ WRITE CONFIG "$ h2xs == ""'"+"'Perl' ''vms_prefix':[utils]h2xs.com""" +$ WRITE CONFIG "$!perlcc == ""'"+"'Perl' ''vms_prefix':[utils]perlcc.com""" +$ WRITE CONFIG "$ splain == ""'"+"'Perl' ''vms_prefix':[utils]splain.com""" $ ELSE -$ WRITE CONFIG "$ Perldoc == ""Perl Perl_Root:[lib.pod]Perldoc.com -t""" +$ WRITE CONFIG "$ Perldoc == ""Perl ''vms_prefix':[lib.pod]Perldoc.com -t""" $ WRITE CONFIG "$ pod2text == ""Perl pod2text""" $ WRITE CONFIG "$ pod2html == ""Perl pod2html""" -$ WRITE CONFIG "$ pod2latex == ""Perl Perl_Root:[lib.pod]pod2latex.com""" +$ WRITE CONFIG "$ pod2latex == ""Perl ''vms_prefix':[lib.pod]pod2latex.com""" $ WRITE CONFIG "$!pod2man == ""Perl pod2man""" -$ WRITE CONFIG "$!Perlbug == ""Perl Perl_Root:[lib]Perlbug.com""" -$ WRITE CONFIG "$ c2ph == ""Perl Perl_Root:[utils]c2ph.com""" +$ WRITE CONFIG "$!Perlbug == ""Perl ''vms_prefix':[lib]Perlbug.com""" +$ WRITE CONFIG "$ c2ph == ""Perl ''vms_prefix':[utils]c2ph.com""" $ IF F$LOCATE("Devel::DProf",extensions) .LT. F$LENGTH(extensions) $ THEN -$ WRITE CONFIG "$ dprofpp == ""Perl Perl_Root:[utils]dprofpp.com""" +$ WRITE CONFIG "$ dprofpp == ""Perl ''vms_prefix':[utils]dprofpp.com""" $ ENDIF -$ WRITE CONFIG "$ h2ph == ""Perl Perl_Root:[utils]h2ph.com""" -$ WRITE CONFIG "$ h2xs == ""Perl Perl_Root:[utils]h2xs.com""" -$ WRITE CONFIG "$!perlcc == ""Perl Perl_Root:[utils]perlcc.com""" -$ WRITE CONFIG "$ splain == ""Perl Perl_Root:[utils]splain.com""" +$ WRITE CONFIG "$ h2ph == ""Perl ''vms_prefix':[utils]h2ph.com""" +$ WRITE CONFIG "$ h2xs == ""Perl ''vms_prefix':[utils]h2xs.com""" +$ WRITE CONFIG "$!perlcc == ""Perl ''vms_prefix':[utils]perlcc.com""" +$ WRITE CONFIG "$ splain == ""Perl ''vms_prefix':[utils]splain.com""" $ ENDIF $ CLOSE CONFIG $! $ echo "" -$ echo "%Config-I-VMS, The file can be found at:" -$ echo4 "-Config-I-VMS, ''F$SEARCH(file_2_find)'" -$ echo "-Config-I-VMS, Add that file (or an @ call to it) to your [SY]LOGIN.COM" -$ echo "-Config-I-VMS, when you are satisfied with a successful compilation," -$ echo "-Config-I-VMS, testing, and installation of your perl." +$ echo "The file can be found at:" +$ echo4 " ''F$SEARCH(file_2_find)'" +$ echo "Add that file (or an @ call to it) to your [SY]LOGIN.COM" +$ echo "when you are satisfied with a successful compilation," +$ echo "testing, and installation of your perl." $ echo "" $ IF ((.NOT.perl_symbol) .AND. (perl_verb .EQS. "DCLTABLES")) $ THEN $ file_2_find = "[-]''packageup'_install.com" -$ OPEN/WRITE CONFIG 'file_2_find +$ OPEN/WRITE CONFIG 'file_2_find' $ WRITE CONFIG "$ set command perl /table=sys$common:[syslib]dcltables.exe -" $ WRITE CONFIG " /output=sys$common:[syslib]dcltables.exe" $ WRITE CONFIG "$ install replace sys$common:[syslib]dcltables.exe" $ CLOSE CONFIG $ echo4 "" -$ echo4 "%Config-I-VMS, In order to install the ''packageup' verb into DCLTABLES run:" -$ echo4 "-Config-I-VMS, @ ''F$SEARCH(file_2_find)'" -$ echo4 "-Config-I-VMS, after a successful build, test, and install. Do so with CMKRNL privilege." +$ echo4 "In order to install the ''packageup' verb into DCLTABLES run:" +$ echo4 " @ ''F$SEARCH(file_2_find)'" +$ echo4 "after a successful build, test, and install. Do so with CMKRNL privilege." $ echo4 "" $ ENDIF $! @@ -2441,8 +5879,8 @@ $ THEN $ DEASSIGN SYS$OUTPUT $! DEASSIGN SYS$ERROR $ ENDIF -$ IF F$GETJPI("","FILCNT").NE.vms_filcnt THEN CLOSE CONFIG -$ IF F$GETJPI("","FILCNT").NE.vms_filcnt +$ IF F$GETJPI("","FILCNT").GT.vms_filcnt THEN CLOSE CONFIG +$ IF F$GETJPI("","FILCNT").GT.vms_filcnt $ THEN WRITE SYS$ERROR "%Config-W-VMS, WARNING: There is a file still open" $ ENDIF $ dflt = F$ENVIRONMENT("DEFAULT") @@ -2454,6 +5892,5 @@ $ SET PROTECTION=(SYSTEM:RWED,OWNER:RWED) UU.DIR $ DELETE/NOLOG/NOCONFIRM UU.DIR; $ ENDIF $ SET DEFAULT 'vms_default_directory_name' !be kind rewind -$ STOP $ EXIT $!: End of Configure diff --git a/contrib/perl5/configure.gnu b/contrib/perl5/configure.gnu index 2ef8331833db..f98eb7660f32 100755 --- a/contrib/perl5/configure.gnu +++ b/contrib/perl5/configure.gnu @@ -86,7 +86,7 @@ EOM exit 1 ;; *) - opts="$opts $1" + opts="$opts '$1'" shift ;; esac @@ -126,7 +126,7 @@ case "$verbose" in *) copt="$copt -d";; esac -set X sh Configure $copt $create $opts +eval "set X sh Configure $copt $create $opts" shift echo "$@" exec "$@" diff --git a/contrib/perl5/cop.h b/contrib/perl5/cop.h index e588675012ab..ec32c3571d63 100644 --- a/contrib/perl5/cop.h +++ b/contrib/perl5/cop.h @@ -1,6 +1,6 @@ /* cop.h * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -29,32 +29,33 @@ struct cop { # define CopFILE(c) ((c)->cop_file) # define CopFILEGV(c) (CopFILE(c) \ ? gv_fetchfile(CopFILE(c)) : Nullgv) -# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) /* XXX */ +# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) # define CopFILESV(c) (CopFILE(c) \ ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) # define CopFILEAV(c) (CopFILE(c) \ ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) # define CopSTASHPV(c) ((c)->cop_stashpv) -# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savepv(pv)) /* XXX */ +# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch)) # define CopSTASH(c) (CopSTASHPV(c) \ ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv) -# define CopSTASH_set(c,hv) CopSTASHPV_set(c, HvNAME(hv)) -# define CopSTASH_eq(c,hv) (hv \ +# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch) +# define CopSTASH_eq(c,hv) ((hv) \ && (CopSTASHPV(c) == HvNAME(hv) \ || (CopSTASHPV(c) && HvNAME(hv) \ && strEQ(CopSTASHPV(c), HvNAME(hv))))) #else # define CopFILEGV(c) ((c)->cop_filegv) -# define CopFILEGV_set(c,gv) ((c)->cop_filegv = gv) -# define CopFILE_set(c,pv) ((c)->cop_filegv = gv_fetchfile(pv)) +# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) +# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) # define CopSTASH(c) ((c)->cop_stash) -# define CopSTASH_set(c,hv) ((c)->cop_stash = hv) +# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) -# define CopSTASHPV_set(c,pv) CopSTASH_set(c, gv_stashpv(pv,GV_ADD)) -# define CopSTASH_eq(c,hv) (CopSTASH(c) == hv) + /* cop_stash is not refcounted */ +# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) +# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) #endif /* USE_ITHREADS */ #define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv)) @@ -79,6 +80,7 @@ struct block_sub { U16 olddepth; U8 hasargs; U8 lval; /* XXX merge lval and hasargs? */ + SV ** oldcurpad; }; #define PUSHSUB(cx) \ @@ -105,13 +107,14 @@ struct block_sub { } STMT_END #endif /* USE_THREADS */ -#ifdef USE_ITHREADS - /* junk in @_ spells trouble when cloning CVs, so don't leave any */ -# define CLEAR_ARGARRAY() av_clear(cx->blk_sub.argarray) -#else -# define CLEAR_ARGARRAY() NOOP -#endif /* USE_ITHREADS */ - +/* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't + * leave any (a fast av_clear(ary), basically) */ +#define CLEAR_ARGARRAY(ary) \ + STMT_START { \ + AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary); \ + SvPVX(ary) = (char*)AvALLOC(ary); \ + AvFILLp(ary) = -1; \ + } STMT_END #define POPSUB(cx,sv) \ STMT_START { \ @@ -124,10 +127,10 @@ struct block_sub { cx->blk_sub.argarray = newAV(); \ av_extend(cx->blk_sub.argarray, fill); \ AvFLAGS(cx->blk_sub.argarray) = AVf_REIFY; \ - PL_curpad[0] = (SV*)cx->blk_sub.argarray; \ + cx->blk_sub.oldcurpad[0] = (SV*)cx->blk_sub.argarray; \ } \ else { \ - CLEAR_ARGARRAY(); \ + CLEAR_ARGARRAY(cx->blk_sub.argarray); \ } \ } \ sv = (SV*)cx->blk_sub.cv; \ @@ -390,7 +393,7 @@ Used to indicate scalar context. See C, C, and L. =for apidoc AmU||G_ARRAY -Used to indicate array context. See C, C and +Used to indicate list context. See C, C and L. =for apidoc AmU||G_VOID @@ -423,12 +426,14 @@ L. #define G_NOARGS 8 /* Don't construct a @_ array. */ #define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */ #define G_NODEBUG 32 /* Disable debugging at toplevel. */ +#define G_METHOD 64 /* Calling method. */ /* flag bits for PL_in_eval */ #define EVAL_NULL 0 /* not in an eval */ #define EVAL_INEVAL 1 /* some enclosing scope is an eval */ #define EVAL_WARNONLY 2 /* used by yywarn() when calling yyerror() */ #define EVAL_KEEPERR 4 /* set by Perl_call_sv if G_KEEPERR */ +#define EVAL_INREQUIRE 8 /* The code is being required. */ /* Support for switching (stack and block) contexts. * This ensures magic doesn't invalidate local stack and cx pointers. @@ -494,7 +499,7 @@ typedef struct stackinfo PERL_SI; * PUTBACK/SPAGAIN to flush/refresh any local SP that may be active */ #define POPSTACK \ STMT_START { \ - djSP; \ + dSP; \ PERL_SI *prev = PL_curstackinfo->si_prev; \ if (!prev) { \ PerlIO_printf(Perl_error_log, "panic: POPSTACK\n"); \ diff --git a/contrib/perl5/cv.h b/contrib/perl5/cv.h index adb424e8eaac..2bce8b2cb8da 100644 --- a/contrib/perl5/cv.h +++ b/contrib/perl5/cv.h @@ -1,6 +1,6 @@ /* cv.h * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. diff --git a/contrib/perl5/deb.c b/contrib/perl5/deb.c index 441487f88eff..dec5c06a15ad 100644 --- a/contrib/perl5/deb.c +++ b/contrib/perl5/deb.c @@ -1,6 +1,6 @@ /* deb.c * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -45,7 +45,6 @@ void Perl_vdeb(pTHX_ const char *pat, va_list *args) { #ifdef DEBUGGING - dTHR; char* file = CopFILE(PL_curcop); #ifdef USE_THREADS @@ -65,7 +64,6 @@ I32 Perl_debstackptrs(pTHX) { #ifdef DEBUGGING - dTHR; PerlIO_printf(Perl_debug_log, "%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n", PTR2UV(PL_curstack), PTR2UV(PL_stack_base), @@ -84,7 +82,6 @@ I32 Perl_debstack(pTHX) { #ifdef DEBUGGING - dTHR; I32 top = PL_stack_sp - PL_stack_base; register I32 i = top - 30; I32 *markscan = PL_markstack + PL_curstackinfo->si_markoff; diff --git a/contrib/perl5/doio.c b/contrib/perl5/doio.c index 0121633c84bd..95690f44e232 100644 --- a/contrib/perl5/doio.c +++ b/contrib/perl5/doio.c @@ -1,6 +1,6 @@ /* doio.c * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -51,26 +51,6 @@ #include #endif -/* XXX If this causes problems, set i_unistd=undef in the hint file. */ -#ifdef I_UNISTD -# include -#endif - -#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */ -# include -# if defined(USE_SOCKS) && defined(I_SOCKS) -# include -# endif -# ifdef I_NETBSD -# include -# endif -# ifndef ENOTSOCK -# ifdef I_NET_ERRNO -# include -# endif -# endif -#endif - bool Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp) @@ -87,7 +67,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, register IO *io = GvIOn(gv); PerlIO *saveifp = Nullfp; PerlIO *saveofp = Nullfp; - char savetype = ' '; + char savetype = IoTYPE_CLOSED; int writing = 0; PerlIO *fp; int fd; @@ -108,7 +88,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (IoIFP(io)) { fd = PerlIO_fileno(IoIFP(io)); - if (IoTYPE(io) == '-') + if (IoTYPE(io) == IoTYPE_STD) result = 0; else if (fd <= PL_maxsysfd) { saveifp = IoIFP(io); @@ -116,7 +96,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, savetype = IoTYPE(io); result = 0; } - else if (IoTYPE(io) == '|') + else if (IoTYPE(io) == IoTYPE_PIPE) result = PerlProc_pclose(IoIFP(io)); else if (IoIFP(io) != IoOFP(io)) { if (IoOFP(io)) { @@ -146,14 +126,14 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, switch (result = rawmode & O_ACCMODE) { case O_RDONLY: - IoTYPE(io) = '<'; + IoTYPE(io) = IoTYPE_RDONLY; break; case O_WRONLY: - IoTYPE(io) = '>'; + IoTYPE(io) = IoTYPE_WRONLY; break; case O_RDWR: default: - IoTYPE(io) = '+'; + IoTYPE(io) = IoTYPE_RDWR; break; } @@ -216,14 +196,14 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } mode[0] = mode[1] = mode[2] = mode[3] = '\0'; IoTYPE(io) = *type; - if (*type == '+' && tlen > 1 && type[tlen-1] != '|') { /* scary */ + if (*type == IoTYPE_RDWR && tlen > 1 && type[tlen-1] != IoTYPE_PIPE) { /* scary */ mode[1] = *type++; --tlen; writing = 1; } - if (*type == '|') { - if (num_svs && (tlen != 2 || type[1] != '-')) { + if (*type == IoTYPE_PIPE) { + if (num_svs && (tlen != 2 || type[1] != IoTYPE_STD)) { unknown_desr: Perl_croak(aTHX_ "Unknown open() mode '%.*s'", (int)olen, oname); } @@ -234,7 +214,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, len = tlen; } if (*name == '\0') { /* command is missing 19990114 */ - dTHR; if (ckWARN(WARN_PIPE)) Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open"); errno = EPIPE; @@ -244,7 +223,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, TAINT_ENV(); TAINT_PROPER("piped open"); if (name[len-1] == '|') { - dTHR; name[--len] = '\0' ; if (ckWARN(WARN_PIPE)) Perl_warner(aTHX_ WARN_PIPE, "Can't open bidirectional pipe"); @@ -261,11 +239,12 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } writing = 1; } - else if (*type == '>') { + else if (*type == IoTYPE_WRONLY) { TAINT_PROPER("open"); type++; - if (*type == '>') { - mode[0] = IoTYPE(io) = 'a'; + if (*type == IoTYPE_WRONLY) { + /* Two IoTYPE_WRONLYs in a row make for an IoTYPE_APPEND. */ + mode[0] = IoTYPE(io) = IoTYPE_APPEND; type++; tlen--; } @@ -313,15 +292,30 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, * be optimized away on most platforms; * only Solaris and Linux seem to flush * on that. --jhi */ - PerlIO_seek(fp, 0, SEEK_CUR); +#ifdef USE_SFIO + /* sfio fails to clear error on next + sfwrite, contrary to documentation. + -- Nick Clark */ + if (PerlIO_seek(fp, 0, SEEK_CUR) == -1) + PerlIO_clearerr(fp); +#endif /* On the other hand, do all platforms * take gracefully to flushing a read-only * filehandle? Perhaps we should do * fsetpos(src)+fgetpos(dst)? --nik */ PerlIO_flush(fp); fd = PerlIO_fileno(fp); - if (IoTYPE(thatio) == 's') - IoTYPE(io) = 's'; + /* When dup()ing STDIN, STDOUT or STDERR + * explicitly set appropriate access mode */ + if (IoIFP(thatio) == PerlIO_stdout() + || IoIFP(thatio) == PerlIO_stderr()) + IoTYPE(io) = IoTYPE_WRONLY; + else if (IoIFP(thatio) == PerlIO_stdin()) + IoTYPE(io) = IoTYPE_RDONLY; + /* When dup()ing a socket, say result is + * one as well */ + else if (IoTYPE(thatio) == IoTYPE_SOCKET) + IoTYPE(io) = IoTYPE_SOCKET; } else fd = -1; @@ -339,16 +333,16 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, else { /*SUPPRESS 530*/ for (; isSPACE(*type); type++) ; - if (strEQ(type,"-")) { + if (*type == IoTYPE_STD && !type[1]) { fp = PerlIO_stdout(); - IoTYPE(io) = '-'; + IoTYPE(io) = IoTYPE_STD; } else { fp = PerlIO_open((num_svs ? name : type), mode); } } } - else if (*type == '<') { + else if (*type == IoTYPE_RDONLY) { if (num_svs && tlen != 1) goto unknown_desr; /*SUPPRESS 530*/ @@ -363,16 +357,16 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, name = type; goto duplicity; } - if (strEQ(type,"-")) { + if (*type == IoTYPE_STD && !type[1]) { fp = PerlIO_stdin(); - IoTYPE(io) = '-'; + IoTYPE(io) = IoTYPE_STD; } else fp = PerlIO_open((num_svs ? name : type), mode); } - else if (tlen > 1 && type[tlen-1] == '|') { + else if (tlen > 1 && type[tlen-1] == IoTYPE_PIPE) { if (num_svs) { - if (tlen != 2 || type[0] != '-') + if (tlen != 2 || type[0] != IoTYPE_STD) goto unknown_desr; } else { @@ -384,7 +378,6 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, name = type; } if (*name == '\0') { /* command is missing 19990114 */ - dTHR; if (ckWARN(WARN_PIPE)) Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open"); errno = EPIPE; @@ -403,18 +396,18 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, mode = "r"; fp = PerlProc_popen(name,mode); } - IoTYPE(io) = '|'; + IoTYPE(io) = IoTYPE_PIPE; } else { if (num_svs) goto unknown_desr; name = type; - IoTYPE(io) = '<'; + IoTYPE(io) = IoTYPE_RDONLY; /*SUPPRESS 530*/ for (; isSPACE(*name); name++) ; if (strEQ(name,"-")) { fp = PerlIO_stdin(); - IoTYPE(io) = '-'; + IoTYPE(io) = IoTYPE_STD; } else { char *mode; @@ -429,20 +422,17 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } } if (!fp) { - dTHR; - if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == '<' && strchr(name, '\n')) + if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == IoTYPE_RDONLY && strchr(name, '\n')) Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open"); goto say_false; } - if (IoTYPE(io) && - IoTYPE(io) != '|' && IoTYPE(io) != '-') { - dTHR; + if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD) { if (PerlLIO_fstat(PerlIO_fileno(fp),&PL_statbuf) < 0) { (void)PerlIO_close(fp); goto say_false; } if (S_ISSOCK(PL_statbuf.st_mode)) - IoTYPE(io) = 's'; /* in case a socket was passed in to us */ + IoTYPE(io) = IoTYPE_SOCKET; /* in case a socket was passed in to us */ #ifdef HAS_SOCKET else if ( #ifdef S_IFMT @@ -450,13 +440,15 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, #else !PL_statbuf.st_mode #endif - ) { + && IoTYPE(io) != IoTYPE_WRONLY /* Dups of STD* filehandles already have */ + && IoTYPE(io) != IoTYPE_RDONLY /* type so they aren't marked as sockets */ + ) { /* on OS's that return 0 on fstat()ed pipe */ char tmpbuf[256]; Sock_size_t buflen = sizeof tmpbuf; if (PerlSock_getsockname(PerlIO_fileno(fp), (struct sockaddr *)tmpbuf, &buflen) >= 0 || errno != ENOTSOCK) - IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */ + IoTYPE(io) = IoTYPE_SOCKET; /* some OS's return 0 on fstat()ed socket */ /* but some return 0 for streams too, sigh */ } #endif @@ -476,11 +468,22 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, SV *sv; PerlLIO_dup2(PerlIO_fileno(fp), fd); +#ifdef VMS + if (fd != PerlIO_fileno(PerlIO_stdin())) { + char newname[FILENAME_MAX+1]; + if (fgetname(fp, newname)) { + if (fd == PerlIO_fileno(PerlIO_stdout())) Perl_vmssetuserlnm("SYS$OUTPUT", newname); + if (fd == PerlIO_fileno(PerlIO_stderr())) Perl_vmssetuserlnm("SYS$ERROR", newname); + } + } +#endif + LOCK_FDPID_MUTEX; sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE); (void)SvUPGRADE(sv, SVt_IV); pid = SvIVX(sv); SvIVX(sv) = 0; sv = *av_fetch(PL_fdpid,fd,TRUE); + UNLOCK_FDPID_MUTEX; (void)SvUPGRADE(sv, SVt_IV); SvIVX(sv) = pid; if (!was_fdopen) @@ -501,9 +504,8 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, IoIFP(io) = fp; IoFLAGS(io) &= ~IOf_NOLINE; if (writing) { - dTHR; - if (IoTYPE(io) == 's' - || (IoTYPE(io) == '>' && S_ISCHR(PL_statbuf.st_mode)) ) + if (IoTYPE(io) == IoTYPE_SOCKET + || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) ) { char *mode; if (out_raw) @@ -563,7 +565,6 @@ Perl_nextargv(pTHX_ register GV *gv) } PL_filemode = 0; while (av_len(GvAV(gv)) >= 0) { - dTHR; STRLEN oldlen; sv = av_shift(GvAV(gv)); SAVEFREESV(sv); @@ -712,7 +713,6 @@ Perl_nextargv(pTHX_ register GV *gv) return IoIFP(GvIOp(gv)); } else { - dTHR; if (ckWARN_d(WARN_INPLACE)) { int eno = errno; if (PerlLIO_stat(PL_oldname, &PL_statbuf) >= 0 @@ -771,8 +771,8 @@ Perl_do_pipe(pTHX_ SV *sv, GV *rgv, GV *wgv) IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"); IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"); IoIFP(wstio) = IoOFP(wstio); - IoTYPE(rstio) = '<'; - IoTYPE(wstio) = '>'; + IoTYPE(rstio) = IoTYPE_RDONLY; + IoTYPE(wstio) = IoTYPE_WRONLY; if (!IoIFP(rstio) || !IoOFP(wstio)) { if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio)); else PerlLIO_close(fd[0]); @@ -807,10 +807,8 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit) io = GvIO(gv); if (!io) { /* never opened */ if (not_implicit) { - dTHR; - if (ckWARN(WARN_UNOPENED)) - Perl_warner(aTHX_ WARN_UNOPENED, - "Close on unopened file <%s>",GvENAME(gv)); + if (ckWARN(WARN_UNOPENED)) /* no check for closed here */ + report_evil_fh(gv, io, PL_op->op_type); SETERRNO(EBADF,SS$_IVCHAN); } return FALSE; @@ -821,7 +819,7 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit) IoPAGE(io) = 0; IoLINES_LEFT(io) = IoPAGE_LEN(io); } - IoTYPE(io) = ' '; + IoTYPE(io) = IoTYPE_CLOSED; return retval; } @@ -832,7 +830,7 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit) int status; if (IoIFP(io)) { - if (IoTYPE(io) == '|') { + if (IoTYPE(io) == IoTYPE_PIPE) { status = PerlProc_pclose(IoIFP(io)); if (not_implicit) { STATUS_NATIVE_SET(status); @@ -842,7 +840,7 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit) retval = (status != -1); } } - else if (IoTYPE(io) == '-') + else if (IoTYPE(io) == IoTYPE_STD) retval = TRUE; else { if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { /* a socket */ @@ -864,7 +862,6 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit) bool Perl_do_eof(pTHX_ GV *gv) { - dTHR; register IO *io; int ch; @@ -873,13 +870,22 @@ Perl_do_eof(pTHX_ GV *gv) if (!io) return TRUE; else if (ckWARN(WARN_IO) - && (IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout() + && (IoTYPE(io) == IoTYPE_WRONLY || IoIFP(io) == PerlIO_stdout() || IoIFP(io) == PerlIO_stderr())) { - SV* sv = sv_newmortal(); - gv_efullname3(sv, gv, Nullch); - Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output", - SvPV_nolen(sv)); + /* integrate to report_evil_fh()? */ + char *name = NULL; + if (isGV(gv)) { + SV* sv = sv_newmortal(); + gv_efullname4(sv, gv, Nullch, FALSE); + name = SvPV_nolen(sv); + } + if (name && *name) + Perl_warner(aTHX_ WARN_IO, + "Filehandle %s opened only for output", name); + else + Perl_warner(aTHX_ WARN_IO, + "Filehandle opened only for output"); } while (IoIFP(io)) { @@ -921,11 +927,8 @@ Perl_do_tell(pTHX_ GV *gv) #endif return PerlIO_tell(fp); } - { - dTHR; - if (ckWARN(WARN_UNOPENED)) - Perl_warner(aTHX_ WARN_UNOPENED, "tell() on unopened file"); - } + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); SETERRNO(EBADF,RMS$_IFI); return (Off_t)-1; } @@ -943,11 +946,8 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence) #endif return PerlIO_seek(fp, pos, whence) >= 0; } - { - dTHR; - if (ckWARN(WARN_UNOPENED)) - Perl_warner(aTHX_ WARN_UNOPENED, "seek() on unopened file"); - } + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); SETERRNO(EBADF,RMS$_IFI); return FALSE; } @@ -960,11 +960,8 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence); - { - dTHR; - if (ckWARN(WARN_UNOPENED)) - Perl_warner(aTHX_ WARN_UNOPENED, "sysseek() on unopened file"); - } + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); SETERRNO(EBADF,RMS$_IFI); return (Off_t)-1; } @@ -1140,11 +1137,8 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) } switch (SvTYPE(sv)) { case SVt_NULL: - { - dTHR; - if (ckWARN(WARN_UNINITIALIZED)) - report_uninit(); - } + if (ckWARN(WARN_UNINITIALIZED)) + report_uninit(); return TRUE; case SVt_IV: if (SvIOK(sv)) { @@ -1167,7 +1161,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) * but only until the system hard limit/the filesystem limit, * at which we would get EPERM. Note that when using buffered * io the write failure can be delayed until the flush/close. --jhi */ - if (len && (PerlIO_write(fp,tmps,len) == 0 || PerlIO_error(fp))) + if (len && (PerlIO_write(fp,tmps,len) == 0)) return FALSE; return !PerlIO_error(fp); } @@ -1175,27 +1169,26 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) I32 Perl_my_stat(pTHX) { - djSP; + dSP; IO *io; - GV* tmpgv; + GV* gv; if (PL_op->op_flags & OPf_REF) { EXTEND(SP,1); - tmpgv = cGVOP_gv; + gv = cGVOP_gv; do_fstat: - io = GvIO(tmpgv); + io = GvIO(gv); if (io && IoIFP(io)) { - PL_statgv = tmpgv; + PL_statgv = gv; sv_setpv(PL_statname,""); PL_laststype = OP_STAT; return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache)); } else { - if (tmpgv == PL_defgv) + if (gv == PL_defgv) return PL_laststatval; - if (ckWARN(WARN_UNOPENED)) - Perl_warner(aTHX_ WARN_UNOPENED, "Stat on unopened file <%s>", - GvENAME(tmpgv)); + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); PL_statgv = Nullgv; sv_setpv(PL_statname,""); return (PL_laststatval = -1); @@ -1207,11 +1200,11 @@ Perl_my_stat(pTHX) STRLEN n_a; PUTBACK; if (SvTYPE(sv) == SVt_PVGV) { - tmpgv = (GV*)sv; + gv = (GV*)sv; goto do_fstat; } else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) { - tmpgv = (GV*)SvRV(sv); + gv = (GV*)SvRV(sv); goto do_fstat; } @@ -1229,7 +1222,7 @@ Perl_my_stat(pTHX) I32 Perl_my_lstat(pTHX) { - djSP; + dSP; SV *sv; STRLEN n_a; if (PL_op->op_flags & OPf_REF) { @@ -1271,7 +1264,6 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, STRLEN n_a; if (sp > mark) { - dTHR; New(401,PL_Argv, sp - mark + 1, char*); a = PL_Argv; while (++mark <= sp) { @@ -1281,15 +1273,18 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, *a++ = ""; } *a = Nullch; - if (*PL_Argv[0] != '/') /* will execvp use PATH? */ + if (really) + tmps = SvPV(really, n_a); + if ((!really && *PL_Argv[0] != '/') || + (really && *tmps != '/')) /* will execvp use PATH? */ TAINT_ENV(); /* testing IFS here is overkill, probably */ - if (really && *(tmps = SvPV(really, n_a))) - PerlProc_execvp(tmps,PL_Argv); + if (really && *tmps) + PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv)); else - PerlProc_execvp(PL_Argv[0],PL_Argv); + PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv)); if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s", - PL_Argv[0], Strerror(errno)); + Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s", + (really ? tmps : PL_Argv[0]), Strerror(errno)); if (do_report) { int e = errno; @@ -1419,7 +1414,6 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) goto doshell; } { - dTHR; int e = errno; if (ckWARN(WARN_EXEC)) @@ -1440,7 +1434,6 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) I32 Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) { - dTHR; register I32 val; register I32 val2; register I32 tot = 0; @@ -1725,7 +1718,6 @@ Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective) I32 Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp) { - dTHR; key_t key; I32 n, flags; @@ -1758,7 +1750,6 @@ Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp) I32 Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) { - dTHR; SV *astr; char *a; I32 id, n, cmd, infosize, getinfo; @@ -1883,7 +1874,6 @@ I32 Perl_do_msgsnd(pTHX_ SV **mark, SV **sp) { #ifdef HAS_MSG - dTHR; SV *mstr; char *mbuf; I32 id, msize, flags; @@ -1906,7 +1896,6 @@ I32 Perl_do_msgrcv(pTHX_ SV **mark, SV **sp) { #ifdef HAS_MSG - dTHR; SV *mstr; char *mbuf; long mtype; @@ -1915,6 +1904,9 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp) id = SvIVx(*++mark); mstr = *++mark; + /* suppress warning when reading into undef var --jhi */ + if (! SvOK(mstr)) + sv_setpvn(mstr, "", 0); msize = SvIVx(*++mark); mtype = (long)SvIVx(*++mark); flags = SvIVx(*++mark); @@ -1941,7 +1933,6 @@ I32 Perl_do_semop(pTHX_ SV **mark, SV **sp) { #ifdef HAS_SEM - dTHR; SV *opstr; char *opbuf; I32 id; @@ -1966,7 +1957,6 @@ I32 Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) { #ifdef HAS_SHM - dTHR; SV *mstr; char *mbuf, *shm; I32 id, mpos, msize; diff --git a/contrib/perl5/doop.c b/contrib/perl5/doop.c index 06b1b38d5c85..7c0e7321efc8 100644 --- a/contrib/perl5/doop.c +++ b/contrib/perl5/doop.c @@ -1,6 +1,6 @@ /* doop.c * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -20,126 +20,254 @@ #endif STATIC I32 -S_do_trans_CC_simple(pTHX_ SV *sv) +S_do_trans_simple(pTHX_ SV *sv) { - dTHR; U8 *s; - U8 *send; - I32 matches = 0; - STRLEN len; - short *tbl; - I32 ch; - - tbl = (short*)cPVOP->op_pv; - if (!tbl) - Perl_croak(aTHX_ "panic: do_trans"); - - s = (U8*)SvPV(sv, len); - send = s + len; - - while (s < send) { - if ((ch = tbl[*s]) >= 0) { - matches++; - *s = ch; - } - s++; - } - SvSETMAGIC(sv); - - return matches; -} - -STATIC I32 -S_do_trans_CC_count(pTHX_ SV *sv) -{ - dTHR; - U8 *s; - U8 *send; - I32 matches = 0; - STRLEN len; - short *tbl; - - tbl = (short*)cPVOP->op_pv; - if (!tbl) - Perl_croak(aTHX_ "panic: do_trans"); - - s = (U8*)SvPV(sv, len); - send = s + len; - - while (s < send) { - if (tbl[*s] >= 0) - matches++; - s++; - } - - return matches; -} - -STATIC I32 -S_do_trans_CC_complex(pTHX_ SV *sv) -{ - dTHR; - U8 *s; - U8 *send; U8 *d; + U8 *send; + U8 *dstart; I32 matches = 0; + I32 grows = PL_op->op_private & OPpTRANS_GROWS; STRLEN len; short *tbl; I32 ch; tbl = (short*)cPVOP->op_pv; if (!tbl) - Perl_croak(aTHX_ "panic: do_trans"); + Perl_croak(aTHX_ "panic: do_trans_simple"); s = (U8*)SvPV(sv, len); send = s + len; - d = s; - if (PL_op->op_private & OPpTRANS_SQUASH) { - U8* p = send; - + /* First, take care of non-UTF8 input strings, because they're easy */ + if (!SvUTF8(sv)) { while (s < send) { if ((ch = tbl[*s]) >= 0) { - *d = ch; matches++; - if (p == d - 1 && *p == *d) - matches--; - else - p = d++; + *s++ = ch; } - else if (ch == -1) /* -1 is unmapped character */ - *d++ = *s; /* -2 is delete character */ - s++; + else + s++; } + SvSETMAGIC(sv); + return matches; + } + + /* Allow for expansion: $_="a".chr(400); tr/a/\xFE/, FE needs encoding */ + if (grows) + New(0, d, len*2+1, U8); + else + d = s; + dstart = d; + while (s < send) { + STRLEN ulen; + UV c; + + /* Need to check this, otherwise 128..255 won't match */ + c = utf8_to_uv(s, send - s, &ulen, 0); + if (c < 0x100 && (ch = tbl[c]) >= 0) { + matches++; + if (UTF8_IS_ASCII(ch)) + *d++ = ch; + else + d = uv_to_utf8(d,ch); + s += ulen; + } + else { /* No match -> copy */ + Copy(s, d, ulen, U8); + d += ulen; + s += ulen; + } + } + if (grows) { + sv_setpvn(sv, (char*)dstart, d - dstart); + Safefree(dstart); } else { - while (s < send) { - if ((ch = tbl[*s]) >= 0) { - *d = ch; - matches++; - d++; - } - else if (ch == -1) /* -1 is unmapped character */ - *d++ = *s; /* -2 is delete character */ - s++; - } + *d = '\0'; + SvCUR_set(sv, d - dstart); } - matches += send - d; /* account for disappeared chars */ - *d = '\0'; - SvCUR_set(sv, d - (U8*)SvPVX(sv)); + SvUTF8_on(sv); SvSETMAGIC(sv); + return matches; +} + +STATIC I32 +S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */ +{ + U8 *s; + U8 *send; + I32 matches = 0; + STRLEN len; + short *tbl; + + tbl = (short*)cPVOP->op_pv; + if (!tbl) + Perl_croak(aTHX_ "panic: do_trans_count"); + + s = (U8*)SvPV(sv, len); + send = s + len; + + if (!SvUTF8(sv)) + while (s < send) { + if (tbl[*s++] >= 0) + matches++; + } + else + while (s < send) { + UV c; + STRLEN ulen; + c = utf8_to_uv(s, send - s, &ulen, 0); + if (c < 0x100 && tbl[c] >= 0) + matches++; + s += ulen; + } return matches; } STATIC I32 -S_do_trans_UU_simple(pTHX_ SV *sv) +S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */ { - dTHR; U8 *s; U8 *send; U8 *d; + U8 *dstart; + I32 isutf8; I32 matches = 0; + I32 grows = PL_op->op_private & OPpTRANS_GROWS; + STRLEN len; + short *tbl; + I32 ch; + + tbl = (short*)cPVOP->op_pv; + if (!tbl) + Perl_croak(aTHX_ "panic: do_trans_complex"); + + s = (U8*)SvPV(sv, len); + isutf8 = SvUTF8(sv); + send = s + len; + + if (!isutf8) { + dstart = d = s; + if (PL_op->op_private & OPpTRANS_SQUASH) { + U8* p = send; + while (s < send) { + if ((ch = tbl[*s]) >= 0) { + *d = ch; + matches++; + if (p != d - 1 || *p != *d) + p = d++; + } + else if (ch == -1) /* -1 is unmapped character */ + *d++ = *s; + else if (ch == -2) /* -2 is delete character */ + matches++; + s++; + } + } + else { + while (s < send) { + if ((ch = tbl[*s]) >= 0) { + matches++; + *d++ = ch; + } + else if (ch == -1) /* -1 is unmapped character */ + *d++ = *s; + else if (ch == -2) /* -2 is delete character */ + matches++; + s++; + } + } + *d = '\0'; + SvCUR_set(sv, d - dstart); + } + else { /* isutf8 */ + if (grows) + New(0, d, len*2+1, U8); + else + d = s; + dstart = d; + +#ifdef MACOS_TRADITIONAL +#define comp CoMP /* "comp" is a keyword in some compilers ... */ +#endif + + if (PL_op->op_private & OPpTRANS_SQUASH) { + U8* p = send; + UV pch = 0xfeedface; + while (s < send) { + STRLEN len; + UV comp = utf8_to_uv_simple(s, &len); + + if (comp > 0xff) { /* always unmapped */ + Copy(s, d, len, U8); + d += len; + } + else if ((ch = tbl[comp]) >= 0) { + matches++; + if (ch != pch) { + d = uv_to_utf8(d, ch); + pch = ch; + } + s += len; + continue; + } + else if (ch == -1) { /* -1 is unmapped character */ + Copy(s, d, len, U8); + d += len; + } + else if (ch == -2) /* -2 is delete character */ + matches++; + s += len; + pch = 0xfeedface; + } + } + else { + while (s < send) { + STRLEN len; + UV comp = utf8_to_uv_simple(s, &len); + if (comp > 0xff) { /* always unmapped */ + Copy(s, d, len, U8); + d += len; + } + else if ((ch = tbl[comp]) >= 0) { + d = uv_to_utf8(d, ch); + matches++; + } + else if (ch == -1) { /* -1 is unmapped character */ + Copy(s, d, len, U8); + d += len; + } + else if (ch == -2) /* -2 is delete character */ + matches++; + s += len; + } + } + if (grows) { + sv_setpvn(sv, (char*)dstart, d - dstart); + Safefree(dstart); + } + else { + *d = '\0'; + SvCUR_set(sv, d - dstart); + } + SvUTF8_on(sv); + } + SvSETMAGIC(sv); + return matches; +} + +STATIC I32 +S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */ +{ + U8 *s; + U8 *send; + U8 *d; + U8 *start; + U8 *dstart, *dend; + I32 matches = 0; + I32 grows = PL_op->op_private & OPpTRANS_GROWS; STRLEN len; SV* rv = (SV*)cSVOP->op_sv; @@ -149,15 +277,37 @@ S_do_trans_UU_simple(pTHX_ SV *sv) UV extra = none + 1; UV final; UV uv; + I32 isutf8; + U8 hibit = 0; s = (U8*)SvPV(sv, len); + isutf8 = SvUTF8(sv); + if (!isutf8) { + U8 *t = s, *e = s + len; + while (t < e) + if ((hibit = UTF8_IS_CONTINUED(*t++))) + break; + if (hibit) + s = bytes_to_utf8(s, &len); + } send = s + len; + start = s; svp = hv_fetch(hv, "FINAL", 5, FALSE); if (svp) final = SvUV(*svp); - d = s; + if (grows) { + /* d needs to be bigger than s, in case e.g. upgrading is required */ + New(0, d, len*3+UTF8_MAXLEN, U8); + dend = d + len * 3; + dstart = d; + } + else { + dstart = d = s; + dend = d + len; + } + while (s < send) { if ((uv = swash_fetch(rv, s)) < none) { s += UTF8SKIP(s); @@ -165,31 +315,53 @@ S_do_trans_UU_simple(pTHX_ SV *sv) d = uv_to_utf8(d, uv); } else if (uv == none) { - int i; - for (i = UTF8SKIP(s); i; i--) - *d++ = *s++; + int i = UTF8SKIP(s); + Copy(s, d, i, U8); + d += i; + s += i; } else if (uv == extra) { - s += UTF8SKIP(s); + int i = UTF8SKIP(s); + s += i; matches++; d = uv_to_utf8(d, final); } else s += UTF8SKIP(s); + + if (d > dend) { + STRLEN clen = d - dstart; + STRLEN nlen = dend - dstart + len + UTF8_MAXLEN; + if (!grows) + Perl_croak(aTHX_ "panic: do_trans_complex_utf8"); + Renew(dstart, nlen+UTF8_MAXLEN, U8); + d = dstart + clen; + dend = dstart + nlen; + } + } + if (grows || hibit) { + sv_setpvn(sv, (char*)dstart, d - dstart); + Safefree(dstart); + if (grows && hibit) + Safefree(start); + } + else { + *d = '\0'; + SvCUR_set(sv, d - dstart); } - *d = '\0'; - SvCUR_set(sv, d - (U8*)SvPVX(sv)); SvSETMAGIC(sv); + SvUTF8_on(sv); + if (!isutf8 && !(PL_hints & HINT_UTF8)) + sv_utf8_downgrade(sv, TRUE); return matches; } STATIC I32 -S_do_trans_UU_count(pTHX_ SV *sv) +S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */ { - dTHR; U8 *s; - U8 *send; + U8 *start, *send; I32 matches = 0; STRLEN len; @@ -198,8 +370,17 @@ S_do_trans_UU_count(pTHX_ SV *sv) SV** svp = hv_fetch(hv, "NONE", 4, FALSE); UV none = svp ? SvUV(*svp) : 0x7fffffff; UV uv; + U8 hibit = 0; s = (U8*)SvPV(sv, len); + if (!SvUTF8(sv)) { + U8 *t = s, *e = s + len; + while (t < e) + if ((hibit = !UTF8_IS_ASCII(*t++))) + break; + if (hibit) + start = s = bytes_to_utf8(s, &len); + } send = s + len; while (s < send) { @@ -207,204 +388,22 @@ S_do_trans_UU_count(pTHX_ SV *sv) matches++; s += UTF8SKIP(s); } + if (hibit) + Safefree(start); return matches; } STATIC I32 -S_do_trans_UC_simple(pTHX_ SV *sv) +S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */ { - dTHR; U8 *s; - U8 *send; - U8 *d; - I32 matches = 0; - STRLEN len; - - SV* rv = (SV*)cSVOP->op_sv; - HV* hv = (HV*)SvRV(rv); - SV** svp = hv_fetch(hv, "NONE", 4, FALSE); - UV none = svp ? SvUV(*svp) : 0x7fffffff; - UV extra = none + 1; - UV final; - UV uv; - - s = (U8*)SvPV(sv, len); - send = s + len; - - svp = hv_fetch(hv, "FINAL", 5, FALSE); - if (svp) - final = SvUV(*svp); - - d = s; - while (s < send) { - if ((uv = swash_fetch(rv, s)) < none) { - s += UTF8SKIP(s); - matches++; - *d++ = (U8)uv; - } - else if (uv == none) { - I32 ulen; - uv = utf8_to_uv(s, &ulen); - s += ulen; - *d++ = (U8)uv; - } - else if (uv == extra) { - s += UTF8SKIP(s); - matches++; - *d++ = (U8)final; - } - else - s += UTF8SKIP(s); - } - *d = '\0'; - SvCUR_set(sv, d - (U8*)SvPVX(sv)); - SvSETMAGIC(sv); - - return matches; -} - -STATIC I32 -S_do_trans_CU_simple(pTHX_ SV *sv) -{ - dTHR; - U8 *s; - U8 *send; - U8 *d; - U8 *dst; - I32 matches = 0; - STRLEN len; - - SV* rv = (SV*)cSVOP->op_sv; - HV* hv = (HV*)SvRV(rv); - SV** svp = hv_fetch(hv, "NONE", 4, FALSE); - UV none = svp ? SvUV(*svp) : 0x7fffffff; - UV extra = none + 1; - UV final; - UV uv; - U8 tmpbuf[UTF8_MAXLEN]; - I32 bits = 16; - - s = (U8*)SvPV(sv, len); - send = s + len; - - svp = hv_fetch(hv, "BITS", 4, FALSE); - if (svp) - bits = (I32)SvIV(*svp); - - svp = hv_fetch(hv, "FINAL", 5, FALSE); - if (svp) - final = SvUV(*svp); - - Newz(801, d, len * (bits >> 3) + 1, U8); - dst = d; - - while (s < send) { - uv = *s++; - if (uv < 0x80) - tmpbuf[0] = uv; - else { - tmpbuf[0] = (( uv >> 6) | 0xc0); - tmpbuf[1] = (( uv & 0x3f) | 0x80); - } - - if ((uv = swash_fetch(rv, tmpbuf)) < none) { - matches++; - d = uv_to_utf8(d, uv); - } - else if (uv == none) - d = uv_to_utf8(d, s[-1]); - else if (uv == extra) { - matches++; - d = uv_to_utf8(d, final); - } - } - *d = '\0'; - sv_usepvn_mg(sv, (char*)dst, d - dst); - - return matches; -} - -/* utf-8 to latin-1 */ - -STATIC I32 -S_do_trans_UC_trivial(pTHX_ SV *sv) -{ - dTHR; - U8 *s; - U8 *send; - U8 *d; - STRLEN len; - - s = (U8*)SvPV(sv, len); - send = s + len; - - d = s; - while (s < send) { - if (*s < 0x80) - *d++ = *s++; - else { - I32 ulen; - UV uv = utf8_to_uv(s, &ulen); - s += ulen; - *d++ = (U8)uv; - } - } - *d = '\0'; - SvCUR_set(sv, d - (U8*)SvPVX(sv)); - SvSETMAGIC(sv); - - return SvCUR(sv); -} - -/* latin-1 to utf-8 */ - -STATIC I32 -S_do_trans_CU_trivial(pTHX_ SV *sv) -{ - dTHR; - U8 *s; - U8 *send; - U8 *d; - U8 *dst; - I32 matches; - STRLEN len; - - s = (U8*)SvPV(sv, len); - send = s + len; - - Newz(801, d, len * 2 + 1, U8); - dst = d; - - matches = send - s; - - while (s < send) { - if (*s < 0x80) - *d++ = *s++; - else { - UV uv = *s++; - *d++ = (( uv >> 6) | 0xc0); - *d++ = (( uv & 0x3f) | 0x80); - } - } - *d = '\0'; - sv_usepvn_mg(sv, (char*)dst, d - dst); - - return matches; -} - -STATIC I32 -S_do_trans_UU_complex(pTHX_ SV *sv) -{ - dTHR; - U8 *s; - U8 *send; + U8 *start, *send; U8 *d; I32 matches = 0; I32 squash = PL_op->op_private & OPpTRANS_SQUASH; - I32 from_utf = PL_op->op_private & OPpTRANS_FROM_UTF; - I32 to_utf = PL_op->op_private & OPpTRANS_TO_UTF; I32 del = PL_op->op_private & OPpTRANS_DELETE; + I32 grows = PL_op->op_private & OPpTRANS_GROWS; SV* rv = (SV*)cSVOP->op_sv; HV* hv = (HV*)SvRV(rv); SV** svp = hv_fetch(hv, "NONE", 4, FALSE); @@ -413,166 +412,130 @@ S_do_trans_UU_complex(pTHX_ SV *sv) UV final; UV uv; STRLEN len; - U8 *dst; + U8 *dstart, *dend; + I32 isutf8; + U8 hibit = 0; s = (U8*)SvPV(sv, len); + isutf8 = SvUTF8(sv); + if (!isutf8) { + U8 *t = s, *e = s + len; + while (t < e) + if ((hibit = !UTF8_IS_ASCII(*t++))) + break; + if (hibit) + s = bytes_to_utf8(s, &len); + } send = s + len; + start = s; svp = hv_fetch(hv, "FINAL", 5, FALSE); if (svp) final = SvUV(*svp); - if (PL_op->op_private & OPpTRANS_GROWS) { - I32 bits = 16; - - svp = hv_fetch(hv, "BITS", 4, FALSE); - if (svp) - bits = (I32)SvIV(*svp); - - Newz(801, d, len * (bits >> 3) + 1, U8); - dst = d; + if (grows) { + /* d needs to be bigger than s, in case e.g. upgrading is required */ + New(0, d, len*3+UTF8_MAXLEN, U8); + dend = d + len * 3; + dstart = d; } else { - d = s; - dst = 0; + dstart = d = s; + dend = d + len; } if (squash) { UV puv = 0xfeedface; while (s < send) { - if (from_utf) { - uv = swash_fetch(rv, s); - } - else { - U8 tmpbuf[2]; - uv = *s++; - if (uv < 0x80) - tmpbuf[0] = uv; - else { - tmpbuf[0] = (( uv >> 6) | 0xc0); - tmpbuf[1] = (( uv & 0x3f) | 0x80); - } - uv = swash_fetch(rv, tmpbuf); + uv = swash_fetch(rv, s); + + if (d > dend) { + STRLEN clen = d - dstart; + STRLEN nlen = dend - dstart + len + UTF8_MAXLEN; + if (!grows) + Perl_croak(aTHX_ "panic: do_trans_complex_utf8"); + Renew(dstart, nlen+UTF8_MAXLEN, U8); + d = dstart + clen; + dend = dstart + nlen; } if (uv < none) { matches++; if (uv != puv) { - if (uv >= 0x80 && to_utf) - d = uv_to_utf8(d, uv); - else - *d++ = (U8)uv; + d = uv_to_utf8(d, uv); puv = uv; } - if (from_utf) - s += UTF8SKIP(s); + s += UTF8SKIP(s); continue; } else if (uv == none) { /* "none" is unmapped character */ - if (from_utf) { - if (*s < 0x80) - *d++ = *s++; - else if (to_utf) { - int i; - for (i = UTF8SKIP(s); i; --i) - *d++ = *s++; - } - else { - I32 ulen; - *d++ = (U8)utf8_to_uv(s, &ulen); - s += ulen; - } - } - else { /* must be to_utf only */ - d = uv_to_utf8(d, s[-1]); - } + int i = UTF8SKIP(s); + Copy(s, d, i, U8); + d += i; + s += i; puv = 0xfeedface; continue; } else if (uv == extra && !del) { matches++; if (uv != puv) { - if (final >= 0x80 && to_utf) - d = uv_to_utf8(d, final); - else - *d++ = (U8)final; + d = uv_to_utf8(d, final); puv = final; } - if (from_utf) - s += UTF8SKIP(s); + s += UTF8SKIP(s); continue; } - matches++; /* "none+1" is delete character */ - if (from_utf) - s += UTF8SKIP(s); + matches++; /* "none+1" is delete character */ + s += UTF8SKIP(s); } } else { while (s < send) { - if (from_utf) { - uv = swash_fetch(rv, s); - } - else { - U8 tmpbuf[2]; - uv = *s++; - if (uv < 0x80) - tmpbuf[0] = uv; - else { - tmpbuf[0] = (( uv >> 6) | 0xc0); - tmpbuf[1] = (( uv & 0x3f) | 0x80); - } - uv = swash_fetch(rv, tmpbuf); + uv = swash_fetch(rv, s); + if (d > dend) { + STRLEN clen = d - dstart; + STRLEN nlen = dend - dstart + len + UTF8_MAXLEN; + if (!grows) + Perl_croak(aTHX_ "panic: do_trans_complex_utf8"); + Renew(dstart, nlen+UTF8_MAXLEN, U8); + d = dstart + clen; + dend = dstart + nlen; } if (uv < none) { matches++; - if (uv >= 0x80 && to_utf) - d = uv_to_utf8(d, uv); - else - *d++ = (U8)uv; - if (from_utf) - s += UTF8SKIP(s); + d = uv_to_utf8(d, uv); + s += UTF8SKIP(s); continue; } else if (uv == none) { /* "none" is unmapped character */ - if (from_utf) { - if (*s < 0x80) - *d++ = *s++; - else if (to_utf) { - int i; - for (i = UTF8SKIP(s); i; --i) - *d++ = *s++; - } - else { - I32 ulen; - *d++ = (U8)utf8_to_uv(s, &ulen); - s += ulen; - } - } - else { /* must be to_utf only */ - d = uv_to_utf8(d, s[-1]); - } + int i = UTF8SKIP(s); + Copy(s, d, i, U8); + d += i; + s += i; continue; } else if (uv == extra && !del) { matches++; - if (final >= 0x80 && to_utf) - d = uv_to_utf8(d, final); - else - *d++ = (U8)final; - if (from_utf) - s += UTF8SKIP(s); + d = uv_to_utf8(d, final); + s += UTF8SKIP(s); continue; } - matches++; /* "none+1" is delete character */ - if (from_utf) - s += UTF8SKIP(s); + matches++; /* "none+1" is delete character */ + s += UTF8SKIP(s); } } - if (dst) - sv_usepvn(sv, (char*)dst, d - dst); + if (grows || hibit) { + sv_setpvn(sv, (char*)dstart, d - dstart); + Safefree(dstart); + if (grows && hibit) + Safefree(start); + } else { *d = '\0'; - SvCUR_set(sv, d - (U8*)SvPVX(sv)); + SvCUR_set(sv, d - dstart); } + SvUTF8_on(sv); + if (!isutf8 && !(PL_hints & HINT_UTF8)) + sv_utf8_downgrade(sv, TRUE); SvSETMAGIC(sv); return matches; @@ -581,8 +544,9 @@ S_do_trans_UU_complex(pTHX_ SV *sv) I32 Perl_do_trans(pTHX_ SV *sv) { - dTHR; STRLEN len; + I32 hasutf = (PL_op->op_private & + (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)); if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL)) Perl_croak(aTHX_ PL_no_modify); @@ -592,40 +556,29 @@ Perl_do_trans(pTHX_ SV *sv) return 0; if (!SvPOKp(sv)) (void)SvPV_force(sv, len); - (void)SvPOK_only(sv); + if (!(PL_op->op_private & OPpTRANS_IDENTICAL)) + (void)SvPOK_only_UTF8(sv); DEBUG_t( Perl_deb(aTHX_ "2.TBL\n")); - switch (PL_op->op_private & 63) { + switch (PL_op->op_private & ~hasutf & 63) { case 0: - return do_trans_CC_simple(sv); - - case OPpTRANS_FROM_UTF: - return do_trans_UC_simple(sv); - - case OPpTRANS_TO_UTF: - return do_trans_CU_simple(sv); - - case OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF: - return do_trans_UU_simple(sv); + if (hasutf) + return do_trans_simple_utf8(sv); + else + return do_trans_simple(sv); case OPpTRANS_IDENTICAL: - return do_trans_CC_count(sv); - - case OPpTRANS_FROM_UTF|OPpTRANS_IDENTICAL: - return do_trans_UC_trivial(sv); - - case OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL: - return do_trans_CU_trivial(sv); - - case OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL: - return do_trans_UU_count(sv); + if (hasutf) + return do_trans_count_utf8(sv); + else + return do_trans_count(sv); default: - if (PL_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) - return do_trans_UU_complex(sv); /* could be UC or CU too */ + if (hasutf) + return do_trans_complex_utf8(sv); else - return do_trans_CC_complex(sv); + return do_trans_complex(sv); } } @@ -644,7 +597,7 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s (void)SvUPGRADE(sv, SVt_PV); if (SvLEN(sv) < len + items) { /* current length is way too short */ while (items-- > 0) { - if (*mark && !SvGMAGICAL(*mark) && SvOK(*mark)) { + if (*mark && !SvGAMAGIC(*mark) && SvOK(*mark)) { SvPV(*mark, tmplen); len += tmplen; } @@ -658,22 +611,16 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s } if (items-- > 0) { - char *s; - - if (*mark) { - s = SvPV(*mark, tmplen); - sv_setpvn(sv, s, tmplen); - } - else - sv_setpv(sv, ""); + sv_setpv(sv, ""); + if (*mark) + sv_catsv(sv, *mark); mark++; } else sv_setpv(sv,""); - len = delimlen; - if (len) { + if (delimlen) { for (; items > 0; items--,mark++) { - sv_catpvn(sv,delim,len); + sv_catsv(sv,del); sv_catsv(sv,*mark); } } @@ -697,6 +644,7 @@ Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg) SvTAINTED_on(sv); } +/* currently converts input to bytes if possible, but doesn't sweat failure */ UV Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) { @@ -706,8 +654,12 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) if (offset < 0) return retnum; - if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */ + if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */ Perl_croak(aTHX_ "Illegal number of bits in vec"); + + if (SvUTF8(sv)) + (void) Perl_sv_utf8_downgrade(aTHX_ sv, TRUE); + offset *= size; /* turn into bit offset */ len = (offset + size + 7) / 8; /* required number of bytes */ if (len > srclen) { @@ -739,7 +691,6 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) } #ifdef UV_IS_QUAD else if (size == 64) { - dTHR; if (ckWARN(WARN_PORTABLE)) Perl_warner(aTHX_ WARN_PORTABLE, "Bit vector size > 32 non-portable"); @@ -779,7 +730,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) ((UV) s[offset + 4] << 24) + ((UV) s[offset + 5] << 16); else - retnum = + retnum = ((UV) s[offset ] << 56) + ((UV) s[offset + 1] << 48) + ((UV) s[offset + 2] << 40) + @@ -809,7 +760,6 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) s[offset + 3]; #ifdef UV_IS_QUAD else if (size == 64) { - dTHR; if (ckWARN(WARN_PORTABLE)) Perl_warner(aTHX_ WARN_PORTABLE, "Bit vector size > 32 non-portable"); @@ -829,6 +779,10 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) return retnum; } +/* currently converts input to bytes if possible but doesn't sweat failures, + * although it does ensure that the string it clobbers is not marked as + * utf8-valid any more + */ void Perl_do_vecset(pTHX_ SV *sv) { @@ -844,12 +798,23 @@ Perl_do_vecset(pTHX_ SV *sv) if (!targ) return; s = (unsigned char*)SvPV_force(targ, targlen); + if (SvUTF8(targ)) { + /* This is handled by the SvPOK_only below... + if (!Perl_sv_utf8_downgrade(aTHX_ targ, TRUE)) + SvUTF8_off(targ); + */ + (void) Perl_sv_utf8_downgrade(aTHX_ targ, TRUE); + } + + (void)SvPOK_only(targ); lval = SvUV(sv); offset = LvTARGOFF(sv); + if (offset < 0) + Perl_croak(aTHX_ "Assigning to negative offset in vec"); size = LvTARGLEN(sv); - if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */ + if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */ Perl_croak(aTHX_ "Illegal number of bits in vec"); - + offset *= size; /* turn into bit offset */ len = (offset + size + 7) / 8; /* required number of bytes */ if (len > targlen) { @@ -857,7 +822,7 @@ Perl_do_vecset(pTHX_ SV *sv) (void)memzero(s + targlen, len - targlen + 1); SvCUR_set(targ, len); } - + if (size < 8) { mask = (1 << size) - 1; size = offset & 7; @@ -882,7 +847,6 @@ Perl_do_vecset(pTHX_ SV *sv) } #ifdef UV_IS_QUAD else if (size == 64) { - dTHR; if (ckWARN(WARN_PORTABLE)) Perl_warner(aTHX_ WARN_PORTABLE, "Bit vector size > 32 non-portable"); @@ -905,8 +869,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) { STRLEN len; char *s; - dTHR; - + if (SvTYPE(sv) == SVt_PVAV) { register I32 i; I32 max; @@ -938,15 +901,15 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) char *send = s + len; char *start = s; s = send - 1; - while ((*s & 0xc0) == 0x80) - --s; - if (UTF8SKIP(s) != send - s && ckWARN_d(WARN_UTF8)) - Perl_warner(aTHX_ WARN_UTF8, "Malformed UTF-8 character"); - sv_setpvn(astr, s, send - s); - *s = '\0'; - SvCUR_set(sv, s - start); - SvNIOK_off(sv); - SvUTF8_on(astr); + while (s > start && UTF8_IS_CONTINUATION(*s)) + s--; + if (utf8_to_uv_simple((U8*)s, 0)) { + sv_setpvn(astr, s, send - s); + *s = '\0'; + SvCUR_set(sv, s - start); + SvNIOK_off(sv); + SvUTF8_on(astr); + } } else sv_setpvn(astr, "", 0); @@ -967,7 +930,6 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) I32 Perl_do_chomp(pTHX_ register SV *sv) { - dTHR; register I32 count; STRLEN len; char *s; @@ -1040,12 +1002,11 @@ Perl_do_chomp(pTHX_ register SV *sv) nope: SvSETMAGIC(sv); return count; -} +} void Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) { - dTHR; /* just for taint */ #ifdef LIBERAL register long *dl; register long *ll; @@ -1062,10 +1023,11 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) char *rsave; bool left_utf = DO_UTF8(left); bool right_utf = DO_UTF8(right); + I32 needlen; if (left_utf && !right_utf) sv_utf8_upgrade(right); - if (!left_utf && right_utf) + else if (!left_utf && right_utf) sv_utf8_upgrade(left); if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv))) @@ -1074,17 +1036,23 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) rsave = rc = SvPV(right, rightlen); len = leftlen < rightlen ? leftlen : rightlen; lensave = len; - if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) { + if ((left_utf || right_utf) && (sv == left || sv == right)) { + needlen = optype == OP_BIT_AND ? len : leftlen + rightlen; + Newz(801, dc, needlen + 1, char); + } + else if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) { STRLEN n_a; dc = SvPV_force(sv, n_a); if (SvCUR(sv) < len) { dc = SvGROW(sv, len + 1); (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1); } + if (optype != OP_BIT_AND && (left_utf || right_utf)) + dc = SvGROW(sv, leftlen + rightlen + 1); } else { - I32 needlen = ((optype == OP_BIT_AND) - ? len : (leftlen > rightlen ? leftlen : rightlen)); + needlen = ((optype == OP_BIT_AND) + ? len : (leftlen > rightlen ? leftlen : rightlen)); Newz(801, dc, needlen + 1, char); (void)sv_usepvn(sv, dc, needlen); dc = SvPVX(sv); /* sv_usepvn() calls Renew() */ @@ -1093,35 +1061,33 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) (void)SvPOK_only(sv); if (left_utf || right_utf) { UV duc, luc, ruc; + char *dcsave = dc; STRLEN lulen = leftlen; STRLEN rulen = rightlen; - STRLEN dulen = 0; - I32 ulen; - - if (optype != OP_BIT_AND) - dc = SvGROW(sv, leftlen+rightlen+1); + STRLEN ulen; switch (optype) { case OP_BIT_AND: while (lulen && rulen) { - luc = utf8_to_uv((U8*)lc, &ulen); + luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV); lc += ulen; lulen -= ulen; - ruc = utf8_to_uv((U8*)rc, &ulen); + ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV); rc += ulen; rulen -= ulen; duc = luc & ruc; dc = (char*)uv_to_utf8((U8*)dc, duc); } - dulen = dc - SvPVX(sv); - SvCUR_set(sv, dulen); + if (sv == left || sv == right) + (void)sv_usepvn(sv, dcsave, needlen); + SvCUR_set(sv, dc - dcsave); break; case OP_BIT_XOR: while (lulen && rulen) { - luc = utf8_to_uv((U8*)lc, &ulen); + luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV); lc += ulen; lulen -= ulen; - ruc = utf8_to_uv((U8*)rc, &ulen); + ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV); rc += ulen; rulen -= ulen; duc = luc ^ ruc; @@ -1130,18 +1096,19 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) goto mop_up_utf; case OP_BIT_OR: while (lulen && rulen) { - luc = utf8_to_uv((U8*)lc, &ulen); + luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV); lc += ulen; lulen -= ulen; - ruc = utf8_to_uv((U8*)rc, &ulen); + ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV); rc += ulen; rulen -= ulen; duc = luc | ruc; dc = (char*)uv_to_utf8((U8*)dc, duc); } mop_up_utf: - dulen = dc - SvPVX(sv); - SvCUR_set(sv, dulen); + if (sv == left || sv == right) + (void)sv_usepvn(sv, dcsave, needlen); + SvCUR_set(sv, dc - dcsave); if (rulen) sv_catpvn(sv, rc, rulen); else if (lulen) @@ -1231,7 +1198,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) OP * Perl_do_kv(pTHX) { - djSP; + dSP; HV *hv = (HV*)POPs; HV *keys; register HE *entry; @@ -1240,12 +1207,12 @@ Perl_do_kv(pTHX) I32 dokeys = (PL_op->op_type == OP_KEYS); I32 dovalues = (PL_op->op_type == OP_VALUES); I32 realhv = (SvTYPE(hv) == SVt_PVHV); - - if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV) + + if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV) dokeys = dovalues = TRUE; if (!hv) { - if (PL_op->op_flags & OPf_MOD) { /* lvalue */ + if (PL_op->op_flags & OPf_MOD || LVRET) { /* lvalue */ dTARGET; /* make sure to clear its target here */ if (SvTYPE(TARG) == SVt_PVLV) LvTARG(TARG) = Nullsv; @@ -1264,7 +1231,7 @@ Perl_do_kv(pTHX) IV i; dTARGET; - if (PL_op->op_flags & OPf_MOD) { /* lvalue */ + if (PL_op->op_flags & OPf_MOD || LVRET) { /* lvalue */ if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); sv_magic(TARG, Nullsv, 'k', Nullch, 0); diff --git a/contrib/perl5/dosish.h b/contrib/perl5/dosish.h index 08b48fa0fe80..5f12b9d1b27a 100644 --- a/contrib/perl5/dosish.h +++ b/contrib/perl5/dosish.h @@ -100,7 +100,11 @@ #define fwrite1 fwrite #define Fstat(fd,bufptr) fstat((fd),(bufptr)) -#define Fflush(fp) fflush(fp) +#ifdef DJGPP +# define Fflush(fp) djgpp_fflush(fp) +#else +# define Fflush(fp) fflush(fp) +#endif #define Mkdir(path,mode) mkdir((path),(mode)) #ifndef WIN32 diff --git a/contrib/perl5/dump.c b/contrib/perl5/dump.c index 86c56ce8c88f..c9a788cee16f 100644 --- a/contrib/perl5/dump.c +++ b/contrib/perl5/dump.c @@ -1,6 +1,6 @@ /* dump.c * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -29,7 +29,6 @@ Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...) void Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args) { - dTHR; PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), ""); PerlIO_vprintf(file, pat, *args); } @@ -37,7 +36,6 @@ Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args) void Perl_dump_all(pTHX) { - dTHR; PerlIO_setlinebuf(Perl_debug_log); if (PL_main_root) op_dump(PL_main_root); @@ -47,7 +45,6 @@ Perl_dump_all(pTHX) void Perl_dump_packsubs(pTHX_ HV *stash) { - dTHR; I32 i; HE *entry; @@ -279,9 +276,9 @@ Perl_sv_peek(pTHX_ SV *sv) } } else if (SvNOKp(sv)) { - RESTORE_NUMERIC_STANDARD(); + STORE_NUMERIC_LOCAL_SET_STANDARD(); Perl_sv_catpvf(aTHX_ t, "(%g)",SvNVX(sv)); - RESTORE_NUMERIC_LOCAL(); + RESTORE_NUMERIC_LOCAL(); } else if (SvIOKp(sv)) { if (SvIsUV(sv)) @@ -369,7 +366,6 @@ Perl_pmop_dump(pTHX_ PMOP *pm) void Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) { - dTHR; Perl_dump_indent(aTHX_ level, file, "{\n"); level++; if (o->op_seq) @@ -457,6 +453,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) } else if (o->op_type == OP_ENTERSUB || o->op_type == OP_RV2SV || + o->op_type == OP_GVSV || o->op_type == OP_RV2AV || o->op_type == OP_RV2HV || o->op_type == OP_RV2GV || @@ -768,8 +765,7 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv) void Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim) { - dTHR; - SV *d = sv_newmortal(); + SV *d; char *s; U32 flags; U32 type; @@ -783,7 +779,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo flags = SvFLAGS(sv); type = SvTYPE(sv); - Perl_sv_setpvf(aTHX_ d, + d = Perl_newSVpvf(aTHX_ "(0x%"UVxf") at 0x%"UVxf"\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (", PTR2UV(SvANY(sv)), PTR2UV(sv), (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv), @@ -824,6 +820,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (CvCLONED(sv)) sv_catpv(d, "CLONED,"); if (CvNODEBUG(sv)) sv_catpv(d, "NODEBUG,"); if (SvCOMPILED(sv)) sv_catpv(d, "COMPILED,"); + if (CvLVALUE(sv)) sv_catpv(d, "LVALUE,"); + if (CvMETHOD(sv)) sv_catpv(d, "METHOD,"); break; case SVt_PVHV: if (HvSHAREKEYS(sv)) sv_catpv(d, "SHAREKEYS,"); @@ -833,6 +831,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (GvINTRO(sv)) sv_catpv(d, "INTRO,"); if (GvMULTI(sv)) sv_catpv(d, "MULTI,"); if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,"); + if (GvIN_PAD(sv)) sv_catpv(d, "IN_PAD,"); if (GvIMPORTED(sv)) { sv_catpv(d, "IMPORT"); if (GvIMPORTED(sv) == GVf_IMPORTED) @@ -867,6 +866,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo switch (type) { case SVt_NULL: PerlIO_printf(file, "NULL%s\n", s); + SvREFCNT_dec(d); return; case SVt_IV: PerlIO_printf(file, "IV%s\n", s); @@ -915,6 +915,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo break; default: PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s); + SvREFCNT_dec(d); return; } if (type >= SVt_PVIV || type == SVt_IV) { @@ -927,7 +928,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo PerlIO_putc(file, '\n'); } if (type >= SVt_PVNV || type == SVt_NV) { - RESTORE_NUMERIC_STANDARD(); + STORE_NUMERIC_LOCAL_SET_STANDARD(); /* %Vg doesn't work? --jhi */ #ifdef USE_LONG_DOUBLE Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv)); @@ -940,10 +941,13 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv))); if (nest < maxnest) do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim); + SvREFCNT_dec(d); return; } - if (type < SVt_PV) + if (type < SVt_PV) { + SvREFCNT_dec(d); return; + } if (type <= SVt_PVLV) { if (SvPVX(sv)) { Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv))); @@ -1042,7 +1046,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo theoret = HvKEYS(sv); theoret += theoret * theoret/pow2; PerlIO_putc(file, '\n'); - Perl_dump_indent(aTHX_ level, file, " hash quality = %.1f%%", theoret/sum*100); + Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100); } PerlIO_putc(file, '\n'); Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvKEYS(sv)); @@ -1178,6 +1182,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv)); break; } + SvREFCNT_dec(d); } void diff --git a/contrib/perl5/embed.h b/contrib/perl5/embed.h index d372b2068728..78fa0890bd4f 100644 --- a/contrib/perl5/embed.h +++ b/contrib/perl5/embed.h @@ -71,6 +71,7 @@ #define append_elem Perl_append_elem #define append_list Perl_append_list #define apply Perl_apply +#define apply_attrs_string Perl_apply_attrs_string #define avhv_delete_ent Perl_avhv_delete_ent #define avhv_exists_ent Perl_avhv_exists_ent #define avhv_fetch_ent Perl_avhv_fetch_ent @@ -129,6 +130,7 @@ #define sv_catpvf_mg_nocontext Perl_sv_catpvf_mg_nocontext #define sv_setpvf_mg_nocontext Perl_sv_setpvf_mg_nocontext #define fprintf_nocontext Perl_fprintf_nocontext +#define printf_nocontext Perl_printf_nocontext #endif #define cv_ckproto Perl_cv_ckproto #define cv_clone Perl_cv_clone @@ -229,6 +231,7 @@ #define gv_check Perl_gv_check #define gv_efullname Perl_gv_efullname #define gv_efullname3 Perl_gv_efullname3 +#define gv_efullname4 Perl_gv_efullname4 #define gv_fetchfile Perl_gv_fetchfile #define gv_fetchmeth Perl_gv_fetchmeth #define gv_fetchmethod Perl_gv_fetchmethod @@ -236,6 +239,7 @@ #define gv_fetchpv Perl_gv_fetchpv #define gv_fullname Perl_gv_fullname #define gv_fullname3 Perl_gv_fullname3 +#define gv_fullname4 Perl_gv_fullname4 #define gv_init Perl_gv_init #define gv_stashpv Perl_gv_stashpv #define gv_stashpvn Perl_gv_stashpvn @@ -269,6 +273,8 @@ #define instr Perl_instr #define io_close Perl_io_close #define invert Perl_invert +#define is_gv_magical Perl_is_gv_magical +#define is_lvalue_sub Perl_is_lvalue_sub #define is_uni_alnum Perl_is_uni_alnum #define is_uni_alnumc Perl_is_uni_alnumc #define is_uni_idfirst Perl_is_uni_idfirst @@ -304,6 +310,7 @@ #define to_uni_title_lc Perl_to_uni_title_lc #define to_uni_lower_lc Perl_to_uni_lower_lc #define is_utf8_char Perl_is_utf8_char +#define is_utf8_string Perl_is_utf8_string #define is_utf8_alnum Perl_is_utf8_alnum #define is_utf8_alnumc Perl_is_utf8_alnumc #define is_utf8_idfirst Perl_is_utf8_idfirst @@ -356,6 +363,7 @@ #define magic_nextpack Perl_magic_nextpack #define magic_regdata_cnt Perl_magic_regdata_cnt #define magic_regdatum_get Perl_magic_regdatum_get +#define magic_regdatum_set Perl_magic_regdatum_set #define magic_set Perl_magic_set #define magic_setamagic Perl_magic_setamagic #define magic_setarylen Perl_magic_setarylen @@ -570,6 +578,7 @@ #define save_freeop Perl_save_freeop #define save_freepv Perl_save_freepv #define save_generic_svref Perl_save_generic_svref +#define save_generic_pvref Perl_save_generic_pvref #define save_gp Perl_save_gp #define save_hash Perl_save_hash #define save_helem Perl_save_helem @@ -583,12 +592,14 @@ #define save_iv Perl_save_iv #define save_list Perl_save_list #define save_long Perl_save_long +#define save_mortalizesv Perl_save_mortalizesv #define save_nogv Perl_save_nogv #define save_op Perl_save_op #define save_scalar Perl_save_scalar #define save_pptr Perl_save_pptr #define save_vptr Perl_save_vptr #define save_re_context Perl_save_re_context +#define save_padsv Perl_save_padsv #define save_sptr Perl_save_sptr #define save_svref Perl_save_svref #define save_threadsv Perl_save_threadsv @@ -717,14 +728,19 @@ #define utilize Perl_utilize #define utf16_to_utf8 Perl_utf16_to_utf8 #define utf16_to_utf8_reversed Perl_utf16_to_utf8_reversed +#define utf8_length Perl_utf8_length #define utf8_distance Perl_utf8_distance #define utf8_hop Perl_utf8_hop +#define utf8_to_bytes Perl_utf8_to_bytes +#define bytes_from_utf8 Perl_bytes_from_utf8 +#define bytes_to_utf8 Perl_bytes_to_utf8 +#define utf8_to_uv_simple Perl_utf8_to_uv_simple #define utf8_to_uv Perl_utf8_to_uv #define uv_to_utf8 Perl_uv_to_utf8 #define vivify_defelem Perl_vivify_defelem #define vivify_ref Perl_vivify_ref #define wait4pid Perl_wait4pid -#define report_closed_fh Perl_report_closed_fh +#define report_evil_fh Perl_report_evil_fh #define report_uninit Perl_report_uninit #define warn Perl_warn #define vwarn Perl_vwarn @@ -733,11 +749,10 @@ #define watch Perl_watch #define whichsig Perl_whichsig #define yyerror Perl_yyerror -#if defined(USE_PURE_BISON) -#define yylex Perl_yylex -#else -#define yylex Perl_yylex +#ifdef USE_PURE_BISON +#define yylex_r Perl_yylex_r #endif +#define yylex Perl_yylex #define yyparse Perl_yyparse #define yywarn Perl_yywarn #if defined(MYMALLOC) @@ -759,6 +774,9 @@ #endif #define runops_standard Perl_runops_standard #define runops_debug Perl_runops_debug +#if defined(USE_THREADS) +#define sv_lock Perl_sv_lock +#endif #define sv_catpvf_mg Perl_sv_catpvf_mg #define sv_vcatpvf_mg Perl_sv_vcatpvf_mg #define sv_catpv_mg Perl_sv_catpv_mg @@ -802,6 +820,8 @@ #define sv_utf8_encode Perl_sv_utf8_encode #define sv_utf8_decode Perl_sv_utf8_decode #define sv_force_normal Perl_sv_force_normal +#define sv_add_backref Perl_sv_add_backref +#define sv_del_backref Perl_sv_del_backref #define tmps_grow Perl_tmps_grow #define sv_rvweaken Perl_sv_rvweaken #define magic_killbackrefs Perl_magic_killbackrefs @@ -829,6 +849,12 @@ #define ptr_table_fetch Perl_ptr_table_fetch #define ptr_table_store Perl_ptr_table_store #define ptr_table_split Perl_ptr_table_split +#define ptr_table_clear Perl_ptr_table_clear +#define ptr_table_free Perl_ptr_table_free +#endif +#if defined(HAVE_INTERP_INTERN) +#define sys_intern_clear Perl_sys_intern_clear +#define sys_intern_init Perl_sys_intern_init #endif #if defined(PERL_OBJECT) #else @@ -838,16 +864,12 @@ #define avhv_index S_avhv_index #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -#define do_trans_CC_simple S_do_trans_CC_simple -#define do_trans_CC_count S_do_trans_CC_count -#define do_trans_CC_complex S_do_trans_CC_complex -#define do_trans_UU_simple S_do_trans_UU_simple -#define do_trans_UU_count S_do_trans_UU_count -#define do_trans_UU_complex S_do_trans_UU_complex -#define do_trans_UC_simple S_do_trans_UC_simple -#define do_trans_CU_simple S_do_trans_CU_simple -#define do_trans_UC_trivial S_do_trans_UC_trivial -#define do_trans_CU_trivial S_do_trans_CU_trivial +#define do_trans_simple S_do_trans_simple +#define do_trans_count S_do_trans_count +#define do_trans_complex S_do_trans_complex +#define do_trans_simple_utf8 S_do_trans_simple_utf8 +#define do_trans_count_utf8 S_do_trans_count_utf8 +#define do_trans_complex_utf8 S_do_trans_complex_utf8 #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) #define gv_init_sv S_gv_init_sv @@ -876,6 +898,7 @@ #define scalarboolean S_scalarboolean #define too_few_arguments S_too_few_arguments #define too_many_arguments S_too_many_arguments +#define trlist_upgrade S_trlist_upgrade #define op_clear S_op_clear #define null S_null #define pad_addlex S_pad_addlex @@ -949,7 +972,6 @@ #define dopoptoloop S_dopoptoloop #define dopoptosub S_dopoptosub #define dopoptosub_at S_dopoptosub_at -#define free_closures S_free_closures #define save_lines S_save_lines #define doeval S_doeval #define doopen_pmc S_doopen_pmc @@ -1063,8 +1085,6 @@ #define sv_unglob S_sv_unglob #define not_a_number S_not_a_number #define visit S_visit -#define sv_add_backref S_sv_add_backref -#define sv_del_backref S_sv_del_backref # if defined(DEBUGGING) #define del_sv S_del_sv # endif @@ -1086,6 +1106,7 @@ #define scan_trans S_scan_trans #define scan_word S_scan_word #define skipspace S_skipspace +#define swallow_bom S_swallow_bom #define checkcomma S_checkcomma #define force_ident S_force_ident #define incline S_incline @@ -1099,6 +1120,7 @@ #define sublex_push S_sublex_push #define sublex_start S_sublex_start #define filter_gets S_filter_gets +#define find_in_my_stash S_find_in_my_stash #define new_constant S_new_constant #define ao S_ao #define depcom S_depcom @@ -1118,6 +1140,7 @@ #define isa_lookup S_isa_lookup #endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +#define stdize_locale S_stdize_locale #define mess_alloc S_mess_alloc # if defined(LEAKTEST) #define xstat S_xstat @@ -1151,6 +1174,7 @@ #define ck_open Perl_ck_open #define ck_repeat Perl_ck_repeat #define ck_require Perl_ck_require +#define ck_return Perl_ck_return #define ck_rfun Perl_ck_rfun #define ck_rvconst Perl_ck_rvconst #define ck_sassign Perl_ck_sassign @@ -1161,6 +1185,7 @@ #define ck_spair Perl_ck_spair #define ck_split Perl_ck_split #define ck_subr Perl_ck_subr +#define ck_substr Perl_ck_substr #define ck_svconst Perl_ck_svconst #define ck_trunc Perl_ck_trunc #define pp_aassign Perl_pp_aassign @@ -1536,6 +1561,7 @@ #define append_elem(a,b,c) Perl_append_elem(aTHX_ a,b,c) #define append_list(a,b,c) Perl_append_list(aTHX_ a,b,c) #define apply(a,b,c) Perl_apply(aTHX_ a,b,c) +#define apply_attrs_string(a,b,c,d) Perl_apply_attrs_string(aTHX_ a,b,c,d) #define avhv_delete_ent(a,b,c,d) Perl_avhv_delete_ent(aTHX_ a,b,c,d) #define avhv_exists_ent(a,b,c) Perl_avhv_exists_ent(aTHX_ a,b,c) #define avhv_fetch_ent(a,b,c,d) Perl_avhv_fetch_ent(aTHX_ a,b,c,d) @@ -1676,6 +1702,7 @@ #define gv_check(a) Perl_gv_check(aTHX_ a) #define gv_efullname(a,b) Perl_gv_efullname(aTHX_ a,b) #define gv_efullname3(a,b,c) Perl_gv_efullname3(aTHX_ a,b,c) +#define gv_efullname4(a,b,c,d) Perl_gv_efullname4(aTHX_ a,b,c,d) #define gv_fetchfile(a) Perl_gv_fetchfile(aTHX_ a) #define gv_fetchmeth(a,b,c,d) Perl_gv_fetchmeth(aTHX_ a,b,c,d) #define gv_fetchmethod(a,b) Perl_gv_fetchmethod(aTHX_ a,b) @@ -1683,6 +1710,7 @@ #define gv_fetchpv(a,b,c) Perl_gv_fetchpv(aTHX_ a,b,c) #define gv_fullname(a,b) Perl_gv_fullname(aTHX_ a,b) #define gv_fullname3(a,b,c) Perl_gv_fullname3(aTHX_ a,b,c) +#define gv_fullname4(a,b,c,d) Perl_gv_fullname4(aTHX_ a,b,c,d) #define gv_init(a,b,c,d,e) Perl_gv_init(aTHX_ a,b,c,d,e) #define gv_stashpv(a,b) Perl_gv_stashpv(aTHX_ a,b) #define gv_stashpvn(a,b,c) Perl_gv_stashpvn(aTHX_ a,b,c) @@ -1716,6 +1744,8 @@ #define instr(a,b) Perl_instr(aTHX_ a,b) #define io_close(a,b) Perl_io_close(aTHX_ a,b) #define invert(a) Perl_invert(aTHX_ a) +#define is_gv_magical(a,b,c) Perl_is_gv_magical(aTHX_ a,b,c) +#define is_lvalue_sub() Perl_is_lvalue_sub(aTHX) #define is_uni_alnum(a) Perl_is_uni_alnum(aTHX_ a) #define is_uni_alnumc(a) Perl_is_uni_alnumc(aTHX_ a) #define is_uni_idfirst(a) Perl_is_uni_idfirst(aTHX_ a) @@ -1751,6 +1781,7 @@ #define to_uni_title_lc(a) Perl_to_uni_title_lc(aTHX_ a) #define to_uni_lower_lc(a) Perl_to_uni_lower_lc(aTHX_ a) #define is_utf8_char(a) Perl_is_utf8_char(aTHX_ a) +#define is_utf8_string(a,b) Perl_is_utf8_string(aTHX_ a,b) #define is_utf8_alnum(a) Perl_is_utf8_alnum(aTHX_ a) #define is_utf8_alnumc(a) Perl_is_utf8_alnumc(aTHX_ a) #define is_utf8_idfirst(a) Perl_is_utf8_idfirst(aTHX_ a) @@ -1802,6 +1833,7 @@ #define magic_nextpack(a,b,c) Perl_magic_nextpack(aTHX_ a,b,c) #define magic_regdata_cnt(a,b) Perl_magic_regdata_cnt(aTHX_ a,b) #define magic_regdatum_get(a,b) Perl_magic_regdatum_get(aTHX_ a,b) +#define magic_regdatum_set(a,b) Perl_magic_regdatum_set(aTHX_ a,b) #define magic_set(a,b) Perl_magic_set(aTHX_ a,b) #define magic_setamagic(a,b) Perl_magic_setamagic(aTHX_ a,b) #define magic_setarylen(a,b) Perl_magic_setarylen(aTHX_ a,b) @@ -2014,6 +2046,7 @@ #define save_freeop(a) Perl_save_freeop(aTHX_ a) #define save_freepv(a) Perl_save_freepv(aTHX_ a) #define save_generic_svref(a) Perl_save_generic_svref(aTHX_ a) +#define save_generic_pvref(a) Perl_save_generic_pvref(aTHX_ a) #define save_gp(a,b) Perl_save_gp(aTHX_ a,b) #define save_hash(a) Perl_save_hash(aTHX_ a) #define save_helem(a,b,c) Perl_save_helem(aTHX_ a,b,c) @@ -2027,12 +2060,14 @@ #define save_iv(a) Perl_save_iv(aTHX_ a) #define save_list(a,b) Perl_save_list(aTHX_ a,b) #define save_long(a) Perl_save_long(aTHX_ a) +#define save_mortalizesv(a) Perl_save_mortalizesv(aTHX_ a) #define save_nogv(a) Perl_save_nogv(aTHX_ a) #define save_op() Perl_save_op(aTHX) #define save_scalar(a) Perl_save_scalar(aTHX_ a) #define save_pptr(a) Perl_save_pptr(aTHX_ a) #define save_vptr(a) Perl_save_vptr(aTHX_ a) #define save_re_context() Perl_save_re_context(aTHX) +#define save_padsv(a) Perl_save_padsv(aTHX_ a) #define save_sptr(a) Perl_save_sptr(aTHX_ a) #define save_svref(a) Perl_save_svref(aTHX_ a) #define save_threadsv(a) Perl_save_threadsv(aTHX_ a) @@ -2043,7 +2078,7 @@ #define scalarvoid(a) Perl_scalarvoid(aTHX_ a) #define scan_bin(a,b,c) Perl_scan_bin(aTHX_ a,b,c) #define scan_hex(a,b,c) Perl_scan_hex(aTHX_ a,b,c) -#define scan_num(a) Perl_scan_num(aTHX_ a) +#define scan_num(a,b) Perl_scan_num(aTHX_ a,b) #define scan_oct(a,b,c) Perl_scan_oct(aTHX_ a,b,c) #define scope(a) Perl_scope(aTHX_ a) #define screaminstr(a,b,c,d,e,f) Perl_screaminstr(aTHX_ a,b,c,d,e,f) @@ -2157,27 +2192,31 @@ #define unsharepvn(a,b,c) Perl_unsharepvn(aTHX_ a,b,c) #define unshare_hek(a) Perl_unshare_hek(aTHX_ a) #define utilize(a,b,c,d,e) Perl_utilize(aTHX_ a,b,c,d,e) -#define utf16_to_utf8(a,b,c) Perl_utf16_to_utf8(aTHX_ a,b,c) -#define utf16_to_utf8_reversed(a,b,c) Perl_utf16_to_utf8_reversed(aTHX_ a,b,c) +#define utf16_to_utf8(a,b,c,d) Perl_utf16_to_utf8(aTHX_ a,b,c,d) +#define utf16_to_utf8_reversed(a,b,c,d) Perl_utf16_to_utf8_reversed(aTHX_ a,b,c,d) +#define utf8_length(a,b) Perl_utf8_length(aTHX_ a,b) #define utf8_distance(a,b) Perl_utf8_distance(aTHX_ a,b) #define utf8_hop(a,b) Perl_utf8_hop(aTHX_ a,b) -#define utf8_to_uv(a,b) Perl_utf8_to_uv(aTHX_ a,b) +#define utf8_to_bytes(a,b) Perl_utf8_to_bytes(aTHX_ a,b) +#define bytes_from_utf8(a,b,c) Perl_bytes_from_utf8(aTHX_ a,b,c) +#define bytes_to_utf8(a,b) Perl_bytes_to_utf8(aTHX_ a,b) +#define utf8_to_uv_simple(a,b) Perl_utf8_to_uv_simple(aTHX_ a,b) +#define utf8_to_uv(a,b,c,d) Perl_utf8_to_uv(aTHX_ a,b,c,d) #define uv_to_utf8(a,b) Perl_uv_to_utf8(aTHX_ a,b) #define vivify_defelem(a) Perl_vivify_defelem(aTHX_ a) #define vivify_ref(a,b) Perl_vivify_ref(aTHX_ a,b) #define wait4pid(a,b,c) Perl_wait4pid(aTHX_ a,b,c) -#define report_closed_fh(a,b,c,d) Perl_report_closed_fh(aTHX_ a,b,c,d) +#define report_evil_fh(a,b,c) Perl_report_evil_fh(aTHX_ a,b,c) #define report_uninit() Perl_report_uninit(aTHX) #define vwarn(a,b) Perl_vwarn(aTHX_ a,b) #define vwarner(a,b,c) Perl_vwarner(aTHX_ a,b,c) #define watch(a) Perl_watch(aTHX_ a) #define whichsig(a) Perl_whichsig(aTHX_ a) #define yyerror(a) Perl_yyerror(aTHX_ a) -#if defined(USE_PURE_BISON) -#define yylex(a,b) Perl_yylex(aTHX_ a,b) -#else -#define yylex() Perl_yylex(aTHX) +#ifdef USE_PURE_BISON +#define yylex_r(a,b) Perl_yylex_r(aTHX_ a,b) #endif +#define yylex() Perl_yylex(aTHX) #define yyparse() Perl_yyparse(aTHX) #define yywarn(a) Perl_yywarn(aTHX_ a) #if defined(MYMALLOC) @@ -2199,6 +2238,9 @@ #endif #define runops_standard() Perl_runops_standard(aTHX) #define runops_debug() Perl_runops_debug(aTHX) +#if defined(USE_THREADS) +#define sv_lock(a) Perl_sv_lock(aTHX_ a) +#endif #define sv_vcatpvf_mg(a,b,c) Perl_sv_vcatpvf_mg(aTHX_ a,b,c) #define sv_catpv_mg(a,b) Perl_sv_catpv_mg(aTHX_ a,b) #define sv_catpvn_mg(a,b,c) Perl_sv_catpvn_mg(aTHX_ a,b,c) @@ -2238,6 +2280,8 @@ #define sv_utf8_encode(a) Perl_sv_utf8_encode(aTHX_ a) #define sv_utf8_decode(a) Perl_sv_utf8_decode(aTHX_ a) #define sv_force_normal(a) Perl_sv_force_normal(aTHX_ a) +#define sv_add_backref(a,b) Perl_sv_add_backref(aTHX_ a,b) +#define sv_del_backref(a) Perl_sv_del_backref(aTHX_ a) #define tmps_grow(a) Perl_tmps_grow(aTHX_ a) #define sv_rvweaken(a) Perl_sv_rvweaken(aTHX_ a) #define magic_killbackrefs(a,b) Perl_magic_killbackrefs(aTHX_ a,b) @@ -2265,6 +2309,12 @@ #define ptr_table_fetch(a,b) Perl_ptr_table_fetch(aTHX_ a,b) #define ptr_table_store(a,b,c) Perl_ptr_table_store(aTHX_ a,b,c) #define ptr_table_split(a) Perl_ptr_table_split(aTHX_ a) +#define ptr_table_clear(a) Perl_ptr_table_clear(aTHX_ a) +#define ptr_table_free(a) Perl_ptr_table_free(aTHX_ a) +#endif +#if defined(HAVE_INTERP_INTERN) +#define sys_intern_clear() Perl_sys_intern_clear(aTHX) +#define sys_intern_init() Perl_sys_intern_init(aTHX) #endif #if defined(PERL_OBJECT) #else @@ -2274,16 +2324,12 @@ #define avhv_index(a,b,c) S_avhv_index(aTHX_ a,b,c) #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -#define do_trans_CC_simple(a) S_do_trans_CC_simple(aTHX_ a) -#define do_trans_CC_count(a) S_do_trans_CC_count(aTHX_ a) -#define do_trans_CC_complex(a) S_do_trans_CC_complex(aTHX_ a) -#define do_trans_UU_simple(a) S_do_trans_UU_simple(aTHX_ a) -#define do_trans_UU_count(a) S_do_trans_UU_count(aTHX_ a) -#define do_trans_UU_complex(a) S_do_trans_UU_complex(aTHX_ a) -#define do_trans_UC_simple(a) S_do_trans_UC_simple(aTHX_ a) -#define do_trans_CU_simple(a) S_do_trans_CU_simple(aTHX_ a) -#define do_trans_UC_trivial(a) S_do_trans_UC_trivial(aTHX_ a) -#define do_trans_CU_trivial(a) S_do_trans_CU_trivial(aTHX_ a) +#define do_trans_simple(a) S_do_trans_simple(aTHX_ a) +#define do_trans_count(a) S_do_trans_count(aTHX_ a) +#define do_trans_complex(a) S_do_trans_complex(aTHX_ a) +#define do_trans_simple_utf8(a) S_do_trans_simple_utf8(aTHX_ a) +#define do_trans_count_utf8(a) S_do_trans_count_utf8(aTHX_ a) +#define do_trans_complex_utf8(a) S_do_trans_complex_utf8(aTHX_ a) #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) #define gv_init_sv(a,b) S_gv_init_sv(aTHX_ a,b) @@ -2312,6 +2358,7 @@ #define scalarboolean(a) S_scalarboolean(aTHX_ a) #define too_few_arguments(a,b) S_too_few_arguments(aTHX_ a,b) #define too_many_arguments(a,b) S_too_many_arguments(aTHX_ a,b) +#define trlist_upgrade(a,b) S_trlist_upgrade(aTHX_ a,b) #define op_clear(a) S_op_clear(aTHX_ a) #define null(a) S_null(aTHX_ a) #define pad_addlex(a) S_pad_addlex(aTHX_ a) @@ -2385,7 +2432,6 @@ #define dopoptoloop(a) S_dopoptoloop(aTHX_ a) #define dopoptosub(a) S_dopoptosub(aTHX_ a) #define dopoptosub_at(a,b) S_dopoptosub_at(aTHX_ a,b) -#define free_closures() S_free_closures(aTHX) #define save_lines(a,b) S_save_lines(aTHX_ a,b) #define doeval(a,b) S_doeval(aTHX_ a,b) #define doopen_pmc(a,b) S_doopen_pmc(aTHX_ a,b) @@ -2498,8 +2544,6 @@ #define sv_unglob(a) S_sv_unglob(aTHX_ a) #define not_a_number(a) S_not_a_number(aTHX_ a) #define visit(a) S_visit(aTHX_ a) -#define sv_add_backref(a,b) S_sv_add_backref(aTHX_ a,b) -#define sv_del_backref(a) S_sv_del_backref(aTHX_ a) # if defined(DEBUGGING) #define del_sv(a) S_del_sv(aTHX_ a) # endif @@ -2521,6 +2565,7 @@ #define scan_trans(a) S_scan_trans(aTHX_ a) #define scan_word(a,b,c,d,e) S_scan_word(aTHX_ a,b,c,d,e) #define skipspace(a) S_skipspace(aTHX_ a) +#define swallow_bom(a) S_swallow_bom(aTHX_ a) #define checkcomma(a,b,c) S_checkcomma(aTHX_ a,b,c) #define force_ident(a,b) S_force_ident(aTHX_ a,b) #define incline(a) S_incline(aTHX_ a) @@ -2534,6 +2579,7 @@ #define sublex_push() S_sublex_push(aTHX) #define sublex_start() S_sublex_start(aTHX) #define filter_gets(a,b,c) S_filter_gets(aTHX_ a,b,c) +#define find_in_my_stash(a,b) S_find_in_my_stash(aTHX_ a,b) #define new_constant(a,b,c,d,e,f) S_new_constant(aTHX_ a,b,c,d,e,f) #define ao(a) S_ao(aTHX_ a) #define depcom() S_depcom(aTHX) @@ -2553,6 +2599,7 @@ #define isa_lookup(a,b,c,d) S_isa_lookup(aTHX_ a,b,c,d) #endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +#define stdize_locale(a) S_stdize_locale(aTHX_ a) #define mess_alloc() S_mess_alloc(aTHX) # if defined(LEAKTEST) #define xstat(a) S_xstat(aTHX_ a) @@ -2586,6 +2633,7 @@ #define ck_open(a) Perl_ck_open(aTHX_ a) #define ck_repeat(a) Perl_ck_repeat(aTHX_ a) #define ck_require(a) Perl_ck_require(aTHX_ a) +#define ck_return(a) Perl_ck_return(aTHX_ a) #define ck_rfun(a) Perl_ck_rfun(aTHX_ a) #define ck_rvconst(a) Perl_ck_rvconst(aTHX_ a) #define ck_sassign(a) Perl_ck_sassign(aTHX_ a) @@ -2596,6 +2644,7 @@ #define ck_spair(a) Perl_ck_spair(aTHX_ a) #define ck_split(a) Perl_ck_split(aTHX_ a) #define ck_subr(a) Perl_ck_subr(aTHX_ a) +#define ck_substr(a) Perl_ck_substr(aTHX_ a) #define ck_svconst(a) Perl_ck_svconst(aTHX_ a) #define ck_trunc(a) Perl_ck_trunc(aTHX_ a) #define pp_aassign() Perl_pp_aassign(aTHX) @@ -2981,6 +3030,8 @@ #define append_list Perl_append_list #define Perl_apply CPerlObj::Perl_apply #define apply Perl_apply +#define Perl_apply_attrs_string CPerlObj::Perl_apply_attrs_string +#define apply_attrs_string Perl_apply_attrs_string #define Perl_avhv_delete_ent CPerlObj::Perl_avhv_delete_ent #define avhv_delete_ent Perl_avhv_delete_ent #define Perl_avhv_exists_ent CPerlObj::Perl_avhv_exists_ent @@ -3092,6 +3143,8 @@ #define sv_setpvf_mg_nocontext Perl_sv_setpvf_mg_nocontext #define Perl_fprintf_nocontext CPerlObj::Perl_fprintf_nocontext #define fprintf_nocontext Perl_fprintf_nocontext +#define Perl_printf_nocontext CPerlObj::Perl_printf_nocontext +#define printf_nocontext Perl_printf_nocontext #endif #define Perl_cv_ckproto CPerlObj::Perl_cv_ckproto #define cv_ckproto Perl_cv_ckproto @@ -3281,6 +3334,8 @@ #define gv_efullname Perl_gv_efullname #define Perl_gv_efullname3 CPerlObj::Perl_gv_efullname3 #define gv_efullname3 Perl_gv_efullname3 +#define Perl_gv_efullname4 CPerlObj::Perl_gv_efullname4 +#define gv_efullname4 Perl_gv_efullname4 #define Perl_gv_fetchfile CPerlObj::Perl_gv_fetchfile #define gv_fetchfile Perl_gv_fetchfile #define Perl_gv_fetchmeth CPerlObj::Perl_gv_fetchmeth @@ -3295,6 +3350,8 @@ #define gv_fullname Perl_gv_fullname #define Perl_gv_fullname3 CPerlObj::Perl_gv_fullname3 #define gv_fullname3 Perl_gv_fullname3 +#define Perl_gv_fullname4 CPerlObj::Perl_gv_fullname4 +#define gv_fullname4 Perl_gv_fullname4 #define Perl_gv_init CPerlObj::Perl_gv_init #define gv_init Perl_gv_init #define Perl_gv_stashpv CPerlObj::Perl_gv_stashpv @@ -3361,6 +3418,10 @@ #define io_close Perl_io_close #define Perl_invert CPerlObj::Perl_invert #define invert Perl_invert +#define Perl_is_gv_magical CPerlObj::Perl_is_gv_magical +#define is_gv_magical Perl_is_gv_magical +#define Perl_is_lvalue_sub CPerlObj::Perl_is_lvalue_sub +#define is_lvalue_sub Perl_is_lvalue_sub #define Perl_is_uni_alnum CPerlObj::Perl_is_uni_alnum #define is_uni_alnum Perl_is_uni_alnum #define Perl_is_uni_alnumc CPerlObj::Perl_is_uni_alnumc @@ -3431,6 +3492,8 @@ #define to_uni_lower_lc Perl_to_uni_lower_lc #define Perl_is_utf8_char CPerlObj::Perl_is_utf8_char #define is_utf8_char Perl_is_utf8_char +#define Perl_is_utf8_string CPerlObj::Perl_is_utf8_string +#define is_utf8_string Perl_is_utf8_string #define Perl_is_utf8_alnum CPerlObj::Perl_is_utf8_alnum #define is_utf8_alnum Perl_is_utf8_alnum #define Perl_is_utf8_alnumc CPerlObj::Perl_is_utf8_alnumc @@ -3533,6 +3596,8 @@ #define magic_regdata_cnt Perl_magic_regdata_cnt #define Perl_magic_regdatum_get CPerlObj::Perl_magic_regdatum_get #define magic_regdatum_get Perl_magic_regdatum_get +#define Perl_magic_regdatum_set CPerlObj::Perl_magic_regdatum_set +#define magic_regdatum_set Perl_magic_regdatum_set #define Perl_magic_set CPerlObj::Perl_magic_set #define magic_set Perl_magic_set #define Perl_magic_setamagic CPerlObj::Perl_magic_setamagic @@ -3944,6 +4009,8 @@ #define save_freepv Perl_save_freepv #define Perl_save_generic_svref CPerlObj::Perl_save_generic_svref #define save_generic_svref Perl_save_generic_svref +#define Perl_save_generic_pvref CPerlObj::Perl_save_generic_pvref +#define save_generic_pvref Perl_save_generic_pvref #define Perl_save_gp CPerlObj::Perl_save_gp #define save_gp Perl_save_gp #define Perl_save_hash CPerlObj::Perl_save_hash @@ -3970,6 +4037,8 @@ #define save_list Perl_save_list #define Perl_save_long CPerlObj::Perl_save_long #define save_long Perl_save_long +#define Perl_save_mortalizesv CPerlObj::Perl_save_mortalizesv +#define save_mortalizesv Perl_save_mortalizesv #define Perl_save_nogv CPerlObj::Perl_save_nogv #define save_nogv Perl_save_nogv #define Perl_save_op CPerlObj::Perl_save_op @@ -3982,6 +4051,8 @@ #define save_vptr Perl_save_vptr #define Perl_save_re_context CPerlObj::Perl_save_re_context #define save_re_context Perl_save_re_context +#define Perl_save_padsv CPerlObj::Perl_save_padsv +#define save_padsv Perl_save_padsv #define Perl_save_sptr CPerlObj::Perl_save_sptr #define save_sptr Perl_save_sptr #define Perl_save_svref CPerlObj::Perl_save_svref @@ -4230,10 +4301,20 @@ #define utf16_to_utf8 Perl_utf16_to_utf8 #define Perl_utf16_to_utf8_reversed CPerlObj::Perl_utf16_to_utf8_reversed #define utf16_to_utf8_reversed Perl_utf16_to_utf8_reversed +#define Perl_utf8_length CPerlObj::Perl_utf8_length +#define utf8_length Perl_utf8_length #define Perl_utf8_distance CPerlObj::Perl_utf8_distance #define utf8_distance Perl_utf8_distance #define Perl_utf8_hop CPerlObj::Perl_utf8_hop #define utf8_hop Perl_utf8_hop +#define Perl_utf8_to_bytes CPerlObj::Perl_utf8_to_bytes +#define utf8_to_bytes Perl_utf8_to_bytes +#define Perl_bytes_from_utf8 CPerlObj::Perl_bytes_from_utf8 +#define bytes_from_utf8 Perl_bytes_from_utf8 +#define Perl_bytes_to_utf8 CPerlObj::Perl_bytes_to_utf8 +#define bytes_to_utf8 Perl_bytes_to_utf8 +#define Perl_utf8_to_uv_simple CPerlObj::Perl_utf8_to_uv_simple +#define utf8_to_uv_simple Perl_utf8_to_uv_simple #define Perl_utf8_to_uv CPerlObj::Perl_utf8_to_uv #define utf8_to_uv Perl_utf8_to_uv #define Perl_uv_to_utf8 CPerlObj::Perl_uv_to_utf8 @@ -4244,8 +4325,8 @@ #define vivify_ref Perl_vivify_ref #define Perl_wait4pid CPerlObj::Perl_wait4pid #define wait4pid Perl_wait4pid -#define Perl_report_closed_fh CPerlObj::Perl_report_closed_fh -#define report_closed_fh Perl_report_closed_fh +#define Perl_report_evil_fh CPerlObj::Perl_report_evil_fh +#define report_evil_fh Perl_report_evil_fh #define Perl_report_uninit CPerlObj::Perl_report_uninit #define report_uninit Perl_report_uninit #define Perl_warn CPerlObj::Perl_warn @@ -4262,13 +4343,12 @@ #define whichsig Perl_whichsig #define Perl_yyerror CPerlObj::Perl_yyerror #define yyerror Perl_yyerror -#if defined(USE_PURE_BISON) -#define Perl_yylex CPerlObj::Perl_yylex -#define yylex Perl_yylex -#else -#define Perl_yylex CPerlObj::Perl_yylex -#define yylex Perl_yylex +#ifdef USE_PURE_BISON +#define Perl_yylex_r CPerlObj::Perl_yylex_r +#define yylex_r Perl_yylex_r #endif +#define Perl_yylex CPerlObj::Perl_yylex +#define yylex Perl_yylex #define Perl_yyparse CPerlObj::Perl_yyparse #define yyparse Perl_yyparse #define Perl_yywarn CPerlObj::Perl_yywarn @@ -4305,6 +4385,10 @@ #define runops_standard Perl_runops_standard #define Perl_runops_debug CPerlObj::Perl_runops_debug #define runops_debug Perl_runops_debug +#if defined(USE_THREADS) +#define Perl_sv_lock CPerlObj::Perl_sv_lock +#define sv_lock Perl_sv_lock +#endif #define Perl_sv_catpvf_mg CPerlObj::Perl_sv_catpvf_mg #define sv_catpvf_mg Perl_sv_catpvf_mg #define Perl_sv_vcatpvf_mg CPerlObj::Perl_sv_vcatpvf_mg @@ -4389,6 +4473,10 @@ #define sv_utf8_decode Perl_sv_utf8_decode #define Perl_sv_force_normal CPerlObj::Perl_sv_force_normal #define sv_force_normal Perl_sv_force_normal +#define Perl_sv_add_backref CPerlObj::Perl_sv_add_backref +#define sv_add_backref Perl_sv_add_backref +#define Perl_sv_del_backref CPerlObj::Perl_sv_del_backref +#define sv_del_backref Perl_sv_del_backref #define Perl_tmps_grow CPerlObj::Perl_tmps_grow #define tmps_grow Perl_tmps_grow #define Perl_sv_rvweaken CPerlObj::Perl_sv_rvweaken @@ -4440,6 +4528,16 @@ #define ptr_table_store Perl_ptr_table_store #define Perl_ptr_table_split CPerlObj::Perl_ptr_table_split #define ptr_table_split Perl_ptr_table_split +#define Perl_ptr_table_clear CPerlObj::Perl_ptr_table_clear +#define ptr_table_clear Perl_ptr_table_clear +#define Perl_ptr_table_free CPerlObj::Perl_ptr_table_free +#define ptr_table_free Perl_ptr_table_free +#endif +#if defined(HAVE_INTERP_INTERN) +#define Perl_sys_intern_clear CPerlObj::Perl_sys_intern_clear +#define sys_intern_clear Perl_sys_intern_clear +#define Perl_sys_intern_init CPerlObj::Perl_sys_intern_init +#define sys_intern_init Perl_sys_intern_init #endif #if defined(PERL_OBJECT) #else @@ -4451,26 +4549,18 @@ #define avhv_index S_avhv_index #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -#define S_do_trans_CC_simple CPerlObj::S_do_trans_CC_simple -#define do_trans_CC_simple S_do_trans_CC_simple -#define S_do_trans_CC_count CPerlObj::S_do_trans_CC_count -#define do_trans_CC_count S_do_trans_CC_count -#define S_do_trans_CC_complex CPerlObj::S_do_trans_CC_complex -#define do_trans_CC_complex S_do_trans_CC_complex -#define S_do_trans_UU_simple CPerlObj::S_do_trans_UU_simple -#define do_trans_UU_simple S_do_trans_UU_simple -#define S_do_trans_UU_count CPerlObj::S_do_trans_UU_count -#define do_trans_UU_count S_do_trans_UU_count -#define S_do_trans_UU_complex CPerlObj::S_do_trans_UU_complex -#define do_trans_UU_complex S_do_trans_UU_complex -#define S_do_trans_UC_simple CPerlObj::S_do_trans_UC_simple -#define do_trans_UC_simple S_do_trans_UC_simple -#define S_do_trans_CU_simple CPerlObj::S_do_trans_CU_simple -#define do_trans_CU_simple S_do_trans_CU_simple -#define S_do_trans_UC_trivial CPerlObj::S_do_trans_UC_trivial -#define do_trans_UC_trivial S_do_trans_UC_trivial -#define S_do_trans_CU_trivial CPerlObj::S_do_trans_CU_trivial -#define do_trans_CU_trivial S_do_trans_CU_trivial +#define S_do_trans_simple CPerlObj::S_do_trans_simple +#define do_trans_simple S_do_trans_simple +#define S_do_trans_count CPerlObj::S_do_trans_count +#define do_trans_count S_do_trans_count +#define S_do_trans_complex CPerlObj::S_do_trans_complex +#define do_trans_complex S_do_trans_complex +#define S_do_trans_simple_utf8 CPerlObj::S_do_trans_simple_utf8 +#define do_trans_simple_utf8 S_do_trans_simple_utf8 +#define S_do_trans_count_utf8 CPerlObj::S_do_trans_count_utf8 +#define do_trans_count_utf8 S_do_trans_count_utf8 +#define S_do_trans_complex_utf8 CPerlObj::S_do_trans_complex_utf8 +#define do_trans_complex_utf8 S_do_trans_complex_utf8 #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) #define S_gv_init_sv CPerlObj::S_gv_init_sv @@ -4519,6 +4609,8 @@ #define too_few_arguments S_too_few_arguments #define S_too_many_arguments CPerlObj::S_too_many_arguments #define too_many_arguments S_too_many_arguments +#define S_trlist_upgrade CPerlObj::S_trlist_upgrade +#define trlist_upgrade S_trlist_upgrade #define S_op_clear CPerlObj::S_op_clear #define op_clear S_op_clear #define S_null CPerlObj::S_null @@ -4649,8 +4741,6 @@ #define dopoptosub S_dopoptosub #define S_dopoptosub_at CPerlObj::S_dopoptosub_at #define dopoptosub_at S_dopoptosub_at -#define S_free_closures CPerlObj::S_free_closures -#define free_closures S_free_closures #define S_save_lines CPerlObj::S_save_lines #define save_lines S_save_lines #define S_doeval CPerlObj::S_doeval @@ -4861,10 +4951,6 @@ #define not_a_number S_not_a_number #define S_visit CPerlObj::S_visit #define visit S_visit -#define S_sv_add_backref CPerlObj::S_sv_add_backref -#define sv_add_backref S_sv_add_backref -#define S_sv_del_backref CPerlObj::S_sv_del_backref -#define sv_del_backref S_sv_del_backref # if defined(DEBUGGING) #define S_del_sv CPerlObj::S_del_sv #define del_sv S_del_sv @@ -4903,6 +4989,8 @@ #define scan_word S_scan_word #define S_skipspace CPerlObj::S_skipspace #define skipspace S_skipspace +#define S_swallow_bom CPerlObj::S_swallow_bom +#define swallow_bom S_swallow_bom #define S_checkcomma CPerlObj::S_checkcomma #define checkcomma S_checkcomma #define S_force_ident CPerlObj::S_force_ident @@ -4929,6 +5017,8 @@ #define sublex_start S_sublex_start #define S_filter_gets CPerlObj::S_filter_gets #define filter_gets S_filter_gets +#define S_find_in_my_stash CPerlObj::S_find_in_my_stash +#define find_in_my_stash S_find_in_my_stash #define S_new_constant CPerlObj::S_new_constant #define new_constant S_new_constant #define S_ao CPerlObj::S_ao @@ -4957,6 +5047,8 @@ #define isa_lookup S_isa_lookup #endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +#define S_stdize_locale CPerlObj::S_stdize_locale +#define stdize_locale S_stdize_locale #define S_mess_alloc CPerlObj::S_mess_alloc #define mess_alloc S_mess_alloc # if defined(LEAKTEST) @@ -5018,6 +5110,8 @@ #define ck_repeat Perl_ck_repeat #define Perl_ck_require CPerlObj::Perl_ck_require #define ck_require Perl_ck_require +#define Perl_ck_return CPerlObj::Perl_ck_return +#define ck_return Perl_ck_return #define Perl_ck_rfun CPerlObj::Perl_ck_rfun #define ck_rfun Perl_ck_rfun #define Perl_ck_rvconst CPerlObj::Perl_ck_rvconst @@ -5038,6 +5132,8 @@ #define ck_split Perl_ck_split #define Perl_ck_subr CPerlObj::Perl_ck_subr #define ck_subr Perl_ck_subr +#define Perl_ck_substr CPerlObj::Perl_ck_substr +#define ck_substr Perl_ck_substr #define Perl_ck_svconst CPerlObj::Perl_ck_svconst #define ck_svconst Perl_ck_svconst #define Perl_ck_trunc CPerlObj::Perl_ck_trunc diff --git a/contrib/perl5/embed.pl b/contrib/perl5/embed.pl index 593ab19f5548..2b0f2aabfed2 100755 --- a/contrib/perl5/embed.pl +++ b/contrib/perl5/embed.pl @@ -25,6 +25,7 @@ sub walk_table (&@) { $F = $filename; } else { + unlink $filename; open F, ">$filename" or die "Can't open $filename: $!"; $F = \*F; } @@ -198,6 +199,7 @@ my @extvars = qw(sv_undef sv_yes sv_no na dowarn diehook dirty perl_destruct_level + ppaddr ); sub readsyms (\%$) { @@ -916,6 +918,9 @@ START_EXTERN_C { return &(PL_##v); } #define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHXo) \ { return &(PL_##v); } +#undef PERLVARIC +#define PERLVARIC(v,t,i) const t* Perl_##v##_ptr(pTHXo) \ + { return (const t *)&(PL_##v); } #include "perlvars.h" #undef PERLVAR @@ -1064,6 +1069,16 @@ Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...) return (*PL_StdIO->pVprintf)(PL_StdIO, stream, format, arglist); } +#undef Perl_printf_nocontext +int +Perl_printf_nocontext(const char *format, ...) +{ + dTHXo; + va_list(arglist); + va_start(arglist, format); + return (*PL_StdIO->pVprintf)(PL_StdIO, PerlIO_stdout(), format, arglist); +} + END_EXTERN_C #endif /* PERL_OBJECT */ @@ -1078,12 +1093,12 @@ my %apidocs; my %gutsdocs; my %docfuncs; -sub autodoc ($) { # parse a file and extract documentation info - my($fh) = @_; - my($in, $doc); - +sub autodoc ($$) { # parse a file and extract documentation info + my($fh,$file) = @_; + my($in, $doc, $line); FUNC: while (defined($in = <$fh>)) { + $line++; if ($in =~ /^=for\s+apidoc\s+(.*)\n/) { my $proto = $1; $proto = "||$proto" unless $proto =~ /\|/; @@ -1091,24 +1106,33 @@ FUNC: my $docs = ""; DOC: while (defined($doc = <$fh>)) { + $line++; last DOC if $doc =~ /^=\w+/; + if ($doc =~ m:^\*/$:) { + warn "=cut missing? $file:$line:$doc";; + last DOC; + } $docs .= $doc; } $docs = "\n$docs" if $docs and $docs !~ /^\n/; if ($flags =~ /m/) { if ($flags =~ /A/) { - $apidocs{$name} = [$flags, $docs, $ret, @args]; + $apidocs{$name} = [$flags, $docs, $ret, $file, @args]; } else { - $gutsdocs{$name} = [$flags, $docs, $ret, @args]; + $gutsdocs{$name} = [$flags, $docs, $ret, $file, @args]; } } else { - $docfuncs{$name} = [$flags, $docs, $ret, @args]; + $docfuncs{$name} = [$flags, $docs, $ret, $file, @args]; } - if ($doc =~ /^=for/) { - $in = $doc; - redo FUNC; + if (defined $doc) { + if ($doc =~ /^=for/) { + $in = $doc; + redo FUNC; + } + } else { + warn "$file:$line:$in"; } } } @@ -1116,8 +1140,10 @@ DOC: sub docout ($$$) { # output the docs for one function my($fh, $name, $docref) = @_; - my($flags, $docs, $ret, @args) = @$docref; + my($flags, $docs, $ret, $file, @args) = @$docref; + $docs .= "NOTE: this function is experimental and may change or be +removed without notice.\n\n" if $flags =~ /x/; $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n" if $flags =~ /p/; @@ -1134,12 +1160,13 @@ sub docout ($$$) { # output the docs for one function print $fh "(" . join(", ", @args) . ")"; print $fh "\n\n"; } + print $fh "=for hackers\nFound in file $file\n\n"; } my $file; for $file (glob('*.c'), glob('*.h')) { open F, "< $file" or die "Cannot open $file for docs: $!\n"; - autodoc(\*F); + autodoc(\*F,$file); close F or die "Error closing $file: $!\n"; } @@ -1156,16 +1183,21 @@ walk_table { # load documented functions into approriate hash if ($flags =~ /A/) { my $docref = delete $docfuncs{$func}; warn "no docs for $func\n" unless $docref and @$docref; - $apidocs{$func} = [$docref->[0] . 'A', $docref->[1], $retval, @args]; + $docref->[0].="x" if $flags =~ /M/; + $apidocs{$func} = [$docref->[0] . 'A', $docref->[1], $retval, + $docref->[3], @args]; } else { my $docref = delete $docfuncs{$func}; - $gutsdocs{$func} = [$docref->[0], $docref->[1], $retval, @args]; + $gutsdocs{$func} = [$docref->[0], $docref->[1], $retval, + $docref->[3], @args]; } } return ""; } \*DOC; for (sort keys %docfuncs) { + # Have you used a full for apidoc or just a func name? + # Have you used Ap instead of Am in the for apidoc? warn "Unable to place $_!\n"; } @@ -1235,7 +1267,7 @@ perlintern - autogenerated documentation of purely B =head1 DESCRIPTION This file is the autogenerated documentation of functions in the -Perl intrepreter that are documented using Perl's internal documentation +Perl interpreter that are documented using Perl's internal documentation format but are not marked as part of the Perl API. In other words, B! @@ -1252,7 +1284,7 @@ print GUTS <<'END'; =head1 AUTHORS -The autodocumentation system was orignally added to the Perl core by +The autodocumentation system was originally added to the Perl core by Benjamin Stuhl. Documentation is by whoever was kind enough to document their functions. @@ -1285,6 +1317,7 @@ __END__ : o has no compatibility macro (#define foo Perl_foo) : j not a member of CPerlObj : x not exported +: M may change : : Individual flags may be separated by whitespace. : @@ -1358,6 +1391,7 @@ Ap |bool |Gv_AMupdate |HV* stash p |OP* |append_elem |I32 optype|OP* head|OP* tail p |OP* |append_list |I32 optype|LISTOP* first|LISTOP* last p |I32 |apply |I32 type|SV** mark|SV** sp +Ap |void |apply_attrs_string|char *stashpv|CV *cv|char *attrstr|STRLEN len Ap |SV* |avhv_delete_ent|AV *ar|SV* keysv|I32 flags|U32 hash Ap |bool |avhv_exists_ent|AV *ar|SV* keysv|U32 hash Ap |SV** |avhv_fetch_ent |AV *ar|SV* keysv|I32 lval|U32 hash @@ -1366,17 +1400,17 @@ Ap |HE* |avhv_iternext |AV *ar Ap |SV* |avhv_iterval |AV *ar|HE* entry Ap |HV* |avhv_keys |AV *ar Apd |void |av_clear |AV* ar -Ap |SV* |av_delete |AV* ar|I32 key|I32 flags -Ap |bool |av_exists |AV* ar|I32 key +Apd |SV* |av_delete |AV* ar|I32 key|I32 flags +Apd |bool |av_exists |AV* ar|I32 key Apd |void |av_extend |AV* ar|I32 key -Ap |AV* |av_fake |I32 size|SV** svp +p |AV* |av_fake |I32 size|SV** svp Apd |SV** |av_fetch |AV* ar|I32 key|I32 lval -Ap |void |av_fill |AV* ar|I32 fill +Apd |void |av_fill |AV* ar|I32 fill Apd |I32 |av_len |AV* ar Apd |AV* |av_make |I32 size|SV** svp Apd |SV* |av_pop |AV* ar Apd |void |av_push |AV* ar|SV* val -Ap |void |av_reify |AV* ar +ApM |void |av_reify |AV* ar Apd |SV* |av_shift |AV* ar Apd |SV** |av_store |AV* ar|I32 key|SV* val Apd |void |av_undef |AV* ar @@ -1406,7 +1440,7 @@ Afnrp |void |croak_nocontext|const char* pat|... Afnp |OP* |die_nocontext |const char* pat|... Afnp |void |deb_nocontext |const char* pat|... Afnp |char* |form_nocontext |const char* pat|... -Afnp |void |load_module_nocontext|U32 flags|SV* name|SV* ver|... +Anp |void |load_module_nocontext|U32 flags|SV* name|SV* ver|... Afnp |SV* |mess_nocontext |const char* pat|... Afnp |void |warn_nocontext |const char* pat|... Afnp |void |warner_nocontext|U32 err|const char* pat|... @@ -1416,6 +1450,7 @@ Afnp |void |sv_setpvf_nocontext|SV* sv|const char* pat|... Afnp |void |sv_catpvf_mg_nocontext|SV* sv|const char* pat|... Afnp |void |sv_setpvf_mg_nocontext|SV* sv|const char* pat|... Afnp |int |fprintf_nocontext|PerlIO* stream|const char* fmt|... +Afnp |int |printf_nocontext|const char* fmt|... #endif p |void |cv_ckproto |CV* cv|GV* gv|char* p p |CV* |cv_clone |CV* proto @@ -1447,7 +1482,7 @@ p |OP* |die_where |char* message|STRLEN msglen Ap |void |dounwind |I32 cxix p |bool |do_aexec |SV* really|SV** mark|SV** sp p |bool |do_aexec5 |SV* really|SV** mark|SV** sp|int fd|int flag -Ap |int |do_binmode |PerlIO *fp|int iotype|int flag +Ap |int |do_binmode |PerlIO *fp|int iotype|int mode p |void |do_chop |SV* asv|SV* sv Ap |bool |do_close |GV* gv|bool not_implicit p |bool |do_eof |GV* gv @@ -1464,7 +1499,7 @@ p |I32 |do_msgsnd |SV** mark|SV** sp p |I32 |do_semop |SV** mark|SV** sp p |I32 |do_shmio |I32 optype|SV** mark|SV** sp #endif -p |void |do_join |SV* sv|SV* del|SV** mark|SV** sp +Ap |void |do_join |SV* sv|SV* del|SV** mark|SV** sp p |OP* |do_kv Ap |bool |do_open |GV* gv|char* name|I32 len|int as_raw \ |int rawmode|int rawperm|PerlIO* supplied_fp @@ -1511,7 +1546,7 @@ Ap |char* |vform |const char* pat|va_list* args Ap |void |free_tmps p |OP* |gen_constant_list|OP* o #if !defined(HAS_GETENV_LEN) -p |char* |getenv_len |char* key|unsigned long *len +p |char* |getenv_len |const char* key|unsigned long *len #endif Ap |void |gp_free |GV* gv Ap |GP* |gp_ref |GP* gp @@ -1523,6 +1558,7 @@ Ap |GV* |gv_autoload4 |HV* stash|const char* name|STRLEN len \ Ap |void |gv_check |HV* stash Ap |void |gv_efullname |SV* sv|GV* gv Ap |void |gv_efullname3 |SV* sv|GV* gv|const char* prefix +Ap |void |gv_efullname4 |SV* sv|GV* gv|const char* prefix|bool keepmain Ap |GV* |gv_fetchfile |const char* name Apd |GV* |gv_fetchmeth |HV* stash|const char* name|STRLEN len \ |I32 level @@ -1532,6 +1568,7 @@ Apd |GV* |gv_fetchmethod_autoload|HV* stash|const char* name \ Ap |GV* |gv_fetchpv |const char* name|I32 add|I32 sv_type Ap |void |gv_fullname |SV* sv|GV* gv Ap |void |gv_fullname3 |SV* sv|GV* gv|const char* prefix +Ap |void |gv_fullname4 |SV* sv|GV* gv|const char* prefix|bool keepmain Ap |void |gv_init |GV* gv|HV* stash|const char* name \ |STRLEN len|int multi Apd |HV* |gv_stashpv |const char* name|I32 create @@ -1567,6 +1604,8 @@ p |U32 |intro_my Ap |char* |instr |const char* big|const char* little p |bool |io_close |IO* io|bool not_implicit p |OP* |invert |OP* cmd +dp |bool |is_gv_magical |char *name|STRLEN len|U32 flags +p |I32 |is_lvalue_sub Ap |bool |is_uni_alnum |U32 c Ap |bool |is_uni_alnumc |U32 c Ap |bool |is_uni_idfirst |U32 c @@ -1601,7 +1640,8 @@ Ap |bool |is_uni_xdigit_lc|U32 c Ap |U32 |to_uni_upper_lc|U32 c Ap |U32 |to_uni_title_lc|U32 c Ap |U32 |to_uni_lower_lc|U32 c -Ap |int |is_utf8_char |U8 *p +Apd |STRLEN |is_utf8_char |U8 *p +Apd |bool |is_utf8_string |U8 *s|STRLEN len Ap |bool |is_utf8_alnum |U8 *p Ap |bool |is_utf8_alnumc |U8 *p Ap |bool |is_utf8_idfirst|U8 *p @@ -1625,7 +1665,7 @@ p |void |lex_start |SV* line p |OP* |linklist |OP* o p |OP* |list |OP* o p |OP* |listkids |OP* o -Afp |void |load_module|U32 flags|SV* name|SV* ver|... +Ap |void |load_module|U32 flags|SV* name|SV* ver|... Ap |void |vload_module|U32 flags|SV* name|SV* ver|va_list* args p |OP* |localize |OP* arg|I32 lexical Apd |I32 |looks_like_number|SV* sv @@ -1654,6 +1694,7 @@ p |int |magic_mutexfree|SV* sv|MAGIC* mg p |int |magic_nextpack |SV* sv|MAGIC* mg|SV* key p |U32 |magic_regdata_cnt|SV* sv|MAGIC* mg p |int |magic_regdatum_get|SV* sv|MAGIC* mg +p |int |magic_regdatum_set|SV* sv|MAGIC* mg p |int |magic_set |SV* sv|MAGIC* mg p |int |magic_setamagic|SV* sv|MAGIC* mg p |int |magic_setarylen|SV* sv|MAGIC* mg @@ -1824,9 +1865,9 @@ Apd |HV* |get_hv |const char* name|I32 create Apd |CV* |get_cv |const char* name|I32 create Ap |int |init_i18nl10n |int printwarn Ap |int |init_i18nl14n |int printwarn -Ap |void |new_collate |const char* newcoll -Ap |void |new_ctype |const char* newctype -Ap |void |new_numeric |const char* newcoll +Ap |void |new_collate |char* newcoll +Ap |void |new_ctype |char* newctype +Ap |void |new_numeric |char* newcoll Ap |void |set_numeric_local Ap |void |set_numeric_radix Ap |void |set_numeric_standard @@ -1860,7 +1901,7 @@ p |void |regprop |SV* sv|regnode* o Ap |void |repeatcpy |char* to|const char* from|I32 len|I32 count Ap |char* |rninstr |const char* big|const char* bigend \ |const char* little|const char* lend -p |Sighandler_t|rsignal |int i|Sighandler_t t +Ap |Sighandler_t|rsignal |int i|Sighandler_t t p |int |rsignal_restore|int i|Sigsave_t* t p |int |rsignal_save |int i|Sighandler_t t1|Sigsave_t* t2 p |Sighandler_t|rsignal_state|int i @@ -1885,6 +1926,7 @@ Ap |void |save_freesv |SV* sv p |void |save_freeop |OP* o Ap |void |save_freepv |char* pv Ap |void |save_generic_svref|SV** sptr +Ap |void |save_generic_pvref|char** str Ap |void |save_gp |GV* gv|I32 empty Ap |HV* |save_hash |GV* gv Ap |void |save_helem |HV* hv|SV *key|SV **sptr @@ -1898,12 +1940,14 @@ Ap |void |save_item |SV* item Ap |void |save_iv |IV* iv Ap |void |save_list |SV** sarg|I32 maxsarg Ap |void |save_long |long* longp +Ap |void |save_mortalizesv|SV* sv Ap |void |save_nogv |GV* gv p |void |save_op Ap |SV* |save_scalar |GV* gv Ap |void |save_pptr |char** pptr Ap |void |save_vptr |void* pptr Ap |void |save_re_context +Ap |void |save_padsv |PADOFFSET off Ap |void |save_sptr |SV** sptr Ap |SV* |save_svref |SV** sptr Ap |SV** |save_threadsv |PADOFFSET i @@ -1912,10 +1956,10 @@ p |OP* |scalar |OP* o p |OP* |scalarkids |OP* o p |OP* |scalarseq |OP* o p |OP* |scalarvoid |OP* o -Ap |NV |scan_bin |char* start|I32 len|I32* retlen -Ap |NV |scan_hex |char* start|I32 len|I32* retlen -Ap |char* |scan_num |char* s -Ap |NV |scan_oct |char* start|I32 len|I32* retlen +Ap |NV |scan_bin |char* start|STRLEN len|STRLEN* retlen +Ap |NV |scan_hex |char* start|STRLEN len|STRLEN* retlen +Ap |char* |scan_num |char* s|YYSTYPE *lvalp +Ap |NV |scan_oct |char* start|STRLEN len|STRLEN* retlen p |OP* |scope |OP* o Ap |char* |screaminstr |SV* bigsv|SV* littlesv|I32 start_shift \ |I32 end_shift|I32 *state|I32 last @@ -1945,7 +1989,7 @@ Ap |NV |sv_nv |SV* sv Ap |char* |sv_pvn |SV *sv|STRLEN *len Ap |char* |sv_pvutf8n |SV *sv|STRLEN *len Ap |char* |sv_pvbyten |SV *sv|STRLEN *len -Ap |I32 |sv_true |SV *sv +Apd |I32 |sv_true |SV *sv p |void |sv_add_arena |char* ptr|U32 size|U32 flags Ap |int |sv_backoff |SV* sv Apd |SV* |sv_bless |SV* sv|HV* stash @@ -1955,11 +1999,11 @@ Apd |void |sv_catpv |SV* sv|const char* ptr Apd |void |sv_catpvn |SV* sv|const char* ptr|STRLEN len Apd |void |sv_catsv |SV* dsv|SV* ssv Apd |void |sv_chop |SV* sv|char* ptr -p |void |sv_clean_all +p |I32 |sv_clean_all p |void |sv_clean_objs -Ap |void |sv_clear |SV* sv +Apd |void |sv_clear |SV* sv Apd |I32 |sv_cmp |SV* sv1|SV* sv2 -Ap |I32 |sv_cmp_locale |SV* sv1|SV* sv2 +Apd |I32 |sv_cmp_locale |SV* sv1|SV* sv2 #if defined(USE_LOCALE_COLLATE) Ap |char* |sv_collxfrm |SV* sv|STRLEN* nxp #endif @@ -1968,9 +2012,9 @@ Apd |void |sv_dec |SV* sv Ap |void |sv_dump |SV* sv Apd |bool |sv_derived_from|SV* sv|const char* name Apd |I32 |sv_eq |SV* sv1|SV* sv2 -Ap |void |sv_free |SV* sv +Apd |void |sv_free |SV* sv p |void |sv_free_arenas -Ap |char* |sv_gets |SV* sv|PerlIO* fp|I32 append +Apd |char* |sv_gets |SV* sv|PerlIO* fp|I32 append Apd |char* |sv_grow |SV* sv|STRLEN newlen Apd |void |sv_inc |SV* sv Apd |void |sv_insert |SV* bigsv|STRLEN offset|STRLEN len \ @@ -1978,7 +2022,7 @@ Apd |void |sv_insert |SV* bigsv|STRLEN offset|STRLEN len \ Apd |int |sv_isa |SV* sv|const char* name Apd |int |sv_isobject |SV* sv Apd |STRLEN |sv_len |SV* sv -Ap |STRLEN |sv_len_utf8 |SV* sv +Apd |STRLEN |sv_len_utf8 |SV* sv Apd |void |sv_magic |SV* sv|SV* obj|int how|const char* name \ |I32 namlen Apd |SV* |sv_mortalcopy |SV* oldsv @@ -1987,11 +2031,11 @@ Ap |SV* |sv_newref |SV* sv Ap |char* |sv_peek |SV* sv Ap |void |sv_pos_u2b |SV* sv|I32* offsetp|I32* lenp Ap |void |sv_pos_b2u |SV* sv|I32* offsetp -Ap |char* |sv_pvn_force |SV* sv|STRLEN* lp -Ap |char* |sv_pvutf8n_force|SV* sv|STRLEN* lp +Apd |char* |sv_pvn_force |SV* sv|STRLEN* lp +Apd |char* |sv_pvutf8n_force|SV* sv|STRLEN* lp Ap |char* |sv_pvbyten_force|SV* sv|STRLEN* lp -Ap |char* |sv_reftype |SV* sv|int ob -Ap |void |sv_replace |SV* sv|SV* nsv +Apd |char* |sv_reftype |SV* sv|int ob +Apd |void |sv_replace |SV* sv|SV* nsv Ap |void |sv_report_used Ap |void |sv_reset |char* s|HV* stash Afpd |void |sv_setpvf |SV* sv|const char* pat|... @@ -2010,7 +2054,7 @@ Apd |void |sv_setpvn |SV* sv|const char* ptr|STRLEN len Apd |void |sv_setsv |SV* dsv|SV* ssv Ap |void |sv_taint |SV* sv Ap |bool |sv_tainted |SV* sv -Ap |int |sv_unmagic |SV* sv|int type +Apd |int |sv_unmagic |SV* sv|int type Apd |void |sv_unref |SV* sv Ap |void |sv_untaint |SV* sv Apd |bool |sv_upgrade |SV* sv|U32 mt @@ -2039,29 +2083,33 @@ Ap |void |unlock_condpair|void* svv Ap |void |unsharepvn |const char* sv|I32 len|U32 hash p |void |unshare_hek |HEK* hek p |void |utilize |int aver|I32 floor|OP* version|OP* id|OP* arg -Ap |U8* |utf16_to_utf8 |U16* p|U8 *d|I32 bytelen -Ap |U8* |utf16_to_utf8_reversed|U16* p|U8 *d|I32 bytelen -Ap |I32 |utf8_distance |U8 *a|U8 *b -Ap |U8* |utf8_hop |U8 *s|I32 off -Ap |UV |utf8_to_uv |U8 *s|I32* retlen -Ap |U8* |uv_to_utf8 |U8 *d|UV uv +ApM |U8* |utf16_to_utf8 |U8* p|U8 *d|I32 bytelen|I32 *newlen +ApM |U8* |utf16_to_utf8_reversed|U8* p|U8 *d|I32 bytelen|I32 *newlen +ApMd |STRLEN |utf8_length |U8* s|U8 *e +ApMd |IV |utf8_distance |U8 *a|U8 *b +ApMd |U8* |utf8_hop |U8 *s|I32 off +ApMd |U8* |utf8_to_bytes |U8 *s|STRLEN *len +ApMd |U8* |bytes_from_utf8|U8 *s|STRLEN *len|bool *is_utf8 +ApMd |U8* |bytes_to_utf8 |U8 *s|STRLEN *len +ApMd |UV |utf8_to_uv_simple|U8 *s|STRLEN* retlen +ApMd |UV |utf8_to_uv |U8 *s|STRLEN curlen|STRLEN* retlen|U32 flags +ApMd |U8* |uv_to_utf8 |U8 *d|UV uv p |void |vivify_defelem |SV* sv p |void |vivify_ref |SV* sv|U32 to_what p |I32 |wait4pid |Pid_t pid|int* statusp|int flags -p |void |report_closed_fh|GV *gv|IO *io|const char *func|const char *obj +p |void |report_evil_fh |GV *gv|IO *io|I32 op p |void |report_uninit Afpd |void |warn |const char* pat|... Ap |void |vwarn |const char* pat|va_list* args Afp |void |warner |U32 err|const char* pat|... Ap |void |vwarner |U32 err|const char* pat|va_list* args p |void |watch |char** addr -p |I32 |whichsig |char* sig +Ap |I32 |whichsig |char* sig p |int |yyerror |char* s -#if defined(USE_PURE_BISON) -p |int |yylex |YYSTYPE *lvalp|int *lcharp -#else -p |int |yylex +#ifdef USE_PURE_BISON +p |int |yylex_r |YYSTYPE *lvalp|int *lcharp #endif +p |int |yylex p |int |yyparse p |int |yywarn |char* s #if defined(MYMALLOC) @@ -2083,6 +2131,9 @@ Ap |struct perl_vars *|GetVars #endif Ap |int |runops_standard Ap |int |runops_debug +#if defined(USE_THREADS) +Ap |SV* |sv_lock |SV *sv +#endif Afpd |void |sv_catpvf_mg |SV *sv|const char* pat|... Ap |void |sv_vcatpvf_mg |SV* sv|const char* pat|va_list* args Apd |void |sv_catpv_mg |SV *sv|const char *ptr @@ -2127,13 +2178,15 @@ Ap |char* |sv_2pvbyte_nolen|SV* sv Ap |char* |sv_pv |SV *sv Ap |char* |sv_pvutf8 |SV *sv Ap |char* |sv_pvbyte |SV *sv -Ap |void |sv_utf8_upgrade|SV *sv -Ap |bool |sv_utf8_downgrade|SV *sv|bool fail_ok -Ap |void |sv_utf8_encode |SV *sv -Ap |bool |sv_utf8_decode |SV *sv +ApMd |void |sv_utf8_upgrade|SV *sv +ApMd |bool |sv_utf8_downgrade|SV *sv|bool fail_ok +ApMd |void |sv_utf8_encode |SV *sv +ApM |bool |sv_utf8_decode |SV *sv Ap |void |sv_force_normal|SV *sv +Ap |void |sv_add_backref |SV *tsv|SV *sv +Ap |void |sv_del_backref |SV *sv Ap |void |tmps_grow |I32 n -Ap |SV* |sv_rvweaken |SV *sv +Apd |SV* |sv_rvweaken |SV *sv p |int |magic_killbackrefs|SV *sv|MAGIC *mg Ap |OP* |newANONATTRSUB |I32 floor|OP *proto|OP *attrs|OP *block Ap |CV* |newATTRSUB |I32 floor|OP *o|OP *proto|OP *attrs|OP *block @@ -2160,6 +2213,12 @@ Ap |PTR_TBL_t*|ptr_table_new Ap |void* |ptr_table_fetch|PTR_TBL_t *tbl|void *sv Ap |void |ptr_table_store|PTR_TBL_t *tbl|void *oldsv|void *newsv Ap |void |ptr_table_split|PTR_TBL_t *tbl +Ap |void |ptr_table_clear|PTR_TBL_t *tbl +Ap |void |ptr_table_free|PTR_TBL_t *tbl +#endif +#if defined(HAVE_INTERP_INTERN) +Ap |void |sys_intern_clear +Ap |void |sys_intern_init #endif #if defined(PERL_OBJECT) @@ -2174,16 +2233,12 @@ s |I32 |avhv_index |AV* av|SV* sv|U32 hash #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -s |I32 |do_trans_CC_simple |SV *sv -s |I32 |do_trans_CC_count |SV *sv -s |I32 |do_trans_CC_complex |SV *sv -s |I32 |do_trans_UU_simple |SV *sv -s |I32 |do_trans_UU_count |SV *sv -s |I32 |do_trans_UU_complex |SV *sv -s |I32 |do_trans_UC_simple |SV *sv -s |I32 |do_trans_CU_simple |SV *sv -s |I32 |do_trans_UC_trivial |SV *sv -s |I32 |do_trans_CU_trivial |SV *sv +s |I32 |do_trans_simple |SV *sv +s |I32 |do_trans_count |SV *sv +s |I32 |do_trans_complex |SV *sv +s |I32 |do_trans_simple_utf8 |SV *sv +s |I32 |do_trans_count_utf8 |SV *sv +s |I32 |do_trans_complex_utf8 |SV *sv #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) @@ -2217,6 +2272,7 @@ s |OP* |no_fh_allowed |OP *o s |OP* |scalarboolean |OP *o s |OP* |too_few_arguments|OP *o|char* name s |OP* |too_many_arguments|OP *o|char* name +s |U8* |trlist_upgrade |U8** sp|U8** ep s |void |op_clear |OP* o s |void |null |OP* o s |PADOFFSET|pad_addlex |SV* name @@ -2294,7 +2350,6 @@ s |I32 |dopoptolabel |char *label s |I32 |dopoptoloop |I32 startingblock s |I32 |dopoptosub |I32 startingblock s |I32 |dopoptosub_at |PERL_CONTEXT* cxstk|I32 startingblock -s |void |free_closures s |void |save_lines |AV *array|SV *sv s |OP* |doeval |int gimme|OP** startop s |PerlIO *|doopen_pmc |const char *name|const char *mode @@ -2322,7 +2377,7 @@ s |regnode*|reg |I32|I32 * s |regnode*|reganode |U8|U32 s |regnode*|regatom |I32 * s |regnode*|regbranch |I32 *|I32 -s |void |reguni |UV|char *|I32* +s |void |reguni |UV|char *|STRLEN* s |regnode*|regclass s |regnode*|regclassutf8 s |I32 |regcurly |char * @@ -2420,9 +2475,7 @@ s |void |del_xpvbm |XPVBM* p s |void |del_xrv |XRV* p s |void |sv_unglob |SV* sv s |void |not_a_number |SV *sv -s |void |visit |SVFUNC_t f -s |void |sv_add_backref |SV *tsv|SV *sv -s |void |sv_del_backref |SV *sv +s |I32 |visit |SVFUNC_t f # if defined(DEBUGGING) s |void |del_sv |SV *p # endif @@ -2448,6 +2501,7 @@ s |char* |scan_trans |char *start s |char* |scan_word |char *s|char *dest|STRLEN destlen \ |int allow_package|STRLEN *slp s |char* |skipspace |char *s +s |char* |swallow_bom |U8 *s s |void |checkcomma |char *s|char *name|char *what s |void |force_ident |char *s|int kind s |void |incline |char *s @@ -2461,6 +2515,7 @@ s |I32 |sublex_done s |I32 |sublex_push s |I32 |sublex_start s |char * |filter_gets |SV *sv|PerlIO *fp|STRLEN append +s |HV * |find_in_my_stash|char *pkgname|I32 len s |SV* |new_constant |char *s|STRLEN len|const char *key|SV *sv \ |SV *pv|const char *type s |int |ao |int toketype @@ -2483,6 +2538,7 @@ s |SV*|isa_lookup |HV *stash|const char *name|int len|int level #endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +s |char* |stdize_locale |char* locs s |SV* |mess_alloc # if defined(LEAKTEST) s |void |xstat |int diff --git a/contrib/perl5/embedvar.h b/contrib/perl5/embedvar.h index e790976a18f3..f4ebaa9839ac 100644 --- a/contrib/perl5/embedvar.h +++ b/contrib/perl5/embedvar.h @@ -196,6 +196,7 @@ #define PL_argvoutgv (PERL_GET_INTERP->Iargvoutgv) #define PL_basetime (PERL_GET_INTERP->Ibasetime) #define PL_beginav (PERL_GET_INTERP->Ibeginav) +#define PL_beginav_save (PERL_GET_INTERP->Ibeginav_save) #define PL_bitcount (PERL_GET_INTERP->Ibitcount) #define PL_bufend (PERL_GET_INTERP->Ibufend) #define PL_bufptr (PERL_GET_INTERP->Ibufptr) @@ -228,6 +229,7 @@ #define PL_doextract (PERL_GET_INTERP->Idoextract) #define PL_doswitches (PERL_GET_INTERP->Idoswitches) #define PL_dowarn (PERL_GET_INTERP->Idowarn) +#define PL_dummy1_bincompat (PERL_GET_INTERP->Idummy1_bincompat) #define PL_e_script (PERL_GET_INTERP->Ie_script) #define PL_egid (PERL_GET_INTERP->Iegid) #define PL_endav (PERL_GET_INTERP->Iendav) @@ -246,6 +248,7 @@ #define PL_exitlistlen (PERL_GET_INTERP->Iexitlistlen) #define PL_expect (PERL_GET_INTERP->Iexpect) #define PL_fdpid (PERL_GET_INTERP->Ifdpid) +#define PL_fdpid_mutex (PERL_GET_INTERP->Ifdpid_mutex) #define PL_filemode (PERL_GET_INTERP->Ifilemode) #define PL_forkprocess (PERL_GET_INTERP->Iforkprocess) #define PL_formfeed (PERL_GET_INTERP->Iformfeed) @@ -254,6 +257,7 @@ #define PL_gid (PERL_GET_INTERP->Igid) #define PL_glob_index (PERL_GET_INTERP->Iglob_index) #define PL_globalstash (PERL_GET_INTERP->Iglobalstash) +#define PL_he_arenaroot (PERL_GET_INTERP->Ihe_arenaroot) #define PL_he_root (PERL_GET_INTERP->Ihe_root) #define PL_hintgv (PERL_GET_INTERP->Ihintgv) #define PL_hints (PERL_GET_INTERP->Ihints) @@ -322,9 +326,10 @@ #define PL_nomemok (PERL_GET_INTERP->Inomemok) #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_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) @@ -376,6 +381,7 @@ #define PL_subname (PERL_GET_INTERP->Isubname) #define PL_sv_arenaroot (PERL_GET_INTERP->Isv_arenaroot) #define PL_sv_count (PERL_GET_INTERP->Isv_count) +#define PL_sv_lock_mutex (PERL_GET_INTERP->Isv_lock_mutex) #define PL_sv_mutex (PERL_GET_INTERP->Isv_mutex) #define PL_sv_no (PERL_GET_INTERP->Isv_no) #define PL_sv_objcount (PERL_GET_INTERP->Isv_objcount) @@ -414,16 +420,27 @@ #define PL_widesyscalls (PERL_GET_INTERP->Iwidesyscalls) #define PL_xiv_arenaroot (PERL_GET_INTERP->Ixiv_arenaroot) #define PL_xiv_root (PERL_GET_INTERP->Ixiv_root) +#define PL_xnv_arenaroot (PERL_GET_INTERP->Ixnv_arenaroot) #define PL_xnv_root (PERL_GET_INTERP->Ixnv_root) +#define PL_xpv_arenaroot (PERL_GET_INTERP->Ixpv_arenaroot) #define PL_xpv_root (PERL_GET_INTERP->Ixpv_root) +#define PL_xpvav_arenaroot (PERL_GET_INTERP->Ixpvav_arenaroot) #define PL_xpvav_root (PERL_GET_INTERP->Ixpvav_root) +#define PL_xpvbm_arenaroot (PERL_GET_INTERP->Ixpvbm_arenaroot) #define PL_xpvbm_root (PERL_GET_INTERP->Ixpvbm_root) +#define PL_xpvcv_arenaroot (PERL_GET_INTERP->Ixpvcv_arenaroot) #define PL_xpvcv_root (PERL_GET_INTERP->Ixpvcv_root) +#define PL_xpvhv_arenaroot (PERL_GET_INTERP->Ixpvhv_arenaroot) #define PL_xpvhv_root (PERL_GET_INTERP->Ixpvhv_root) +#define PL_xpviv_arenaroot (PERL_GET_INTERP->Ixpviv_arenaroot) #define PL_xpviv_root (PERL_GET_INTERP->Ixpviv_root) +#define PL_xpvlv_arenaroot (PERL_GET_INTERP->Ixpvlv_arenaroot) #define PL_xpvlv_root (PERL_GET_INTERP->Ixpvlv_root) +#define PL_xpvmg_arenaroot (PERL_GET_INTERP->Ixpvmg_arenaroot) #define PL_xpvmg_root (PERL_GET_INTERP->Ixpvmg_root) +#define PL_xpvnv_arenaroot (PERL_GET_INTERP->Ixpvnv_arenaroot) #define PL_xpvnv_root (PERL_GET_INTERP->Ixpvnv_root) +#define PL_xrv_arenaroot (PERL_GET_INTERP->Ixrv_arenaroot) #define PL_xrv_root (PERL_GET_INTERP->Ixrv_root) #define PL_yychar (PERL_GET_INTERP->Iyychar) #define PL_yydebug (PERL_GET_INTERP->Iyydebug) @@ -460,6 +477,7 @@ #define PL_argvoutgv (vTHX->Iargvoutgv) #define PL_basetime (vTHX->Ibasetime) #define PL_beginav (vTHX->Ibeginav) +#define PL_beginav_save (vTHX->Ibeginav_save) #define PL_bitcount (vTHX->Ibitcount) #define PL_bufend (vTHX->Ibufend) #define PL_bufptr (vTHX->Ibufptr) @@ -492,6 +510,7 @@ #define PL_doextract (vTHX->Idoextract) #define PL_doswitches (vTHX->Idoswitches) #define PL_dowarn (vTHX->Idowarn) +#define PL_dummy1_bincompat (vTHX->Idummy1_bincompat) #define PL_e_script (vTHX->Ie_script) #define PL_egid (vTHX->Iegid) #define PL_endav (vTHX->Iendav) @@ -510,6 +529,7 @@ #define PL_exitlistlen (vTHX->Iexitlistlen) #define PL_expect (vTHX->Iexpect) #define PL_fdpid (vTHX->Ifdpid) +#define PL_fdpid_mutex (vTHX->Ifdpid_mutex) #define PL_filemode (vTHX->Ifilemode) #define PL_forkprocess (vTHX->Iforkprocess) #define PL_formfeed (vTHX->Iformfeed) @@ -518,6 +538,7 @@ #define PL_gid (vTHX->Igid) #define PL_glob_index (vTHX->Iglob_index) #define PL_globalstash (vTHX->Iglobalstash) +#define PL_he_arenaroot (vTHX->Ihe_arenaroot) #define PL_he_root (vTHX->Ihe_root) #define PL_hintgv (vTHX->Ihintgv) #define PL_hints (vTHX->Ihints) @@ -586,9 +607,10 @@ #define PL_nomemok (vTHX->Inomemok) #define PL_nthreads (vTHX->Inthreads) #define PL_nthreads_cond (vTHX->Inthreads_cond) +#define PL_nullstash (vTHX->Inullstash) #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) @@ -640,6 +662,7 @@ #define PL_subname (vTHX->Isubname) #define PL_sv_arenaroot (vTHX->Isv_arenaroot) #define PL_sv_count (vTHX->Isv_count) +#define PL_sv_lock_mutex (vTHX->Isv_lock_mutex) #define PL_sv_mutex (vTHX->Isv_mutex) #define PL_sv_no (vTHX->Isv_no) #define PL_sv_objcount (vTHX->Isv_objcount) @@ -678,16 +701,27 @@ #define PL_widesyscalls (vTHX->Iwidesyscalls) #define PL_xiv_arenaroot (vTHX->Ixiv_arenaroot) #define PL_xiv_root (vTHX->Ixiv_root) +#define PL_xnv_arenaroot (vTHX->Ixnv_arenaroot) #define PL_xnv_root (vTHX->Ixnv_root) +#define PL_xpv_arenaroot (vTHX->Ixpv_arenaroot) #define PL_xpv_root (vTHX->Ixpv_root) +#define PL_xpvav_arenaroot (vTHX->Ixpvav_arenaroot) #define PL_xpvav_root (vTHX->Ixpvav_root) +#define PL_xpvbm_arenaroot (vTHX->Ixpvbm_arenaroot) #define PL_xpvbm_root (vTHX->Ixpvbm_root) +#define PL_xpvcv_arenaroot (vTHX->Ixpvcv_arenaroot) #define PL_xpvcv_root (vTHX->Ixpvcv_root) +#define PL_xpvhv_arenaroot (vTHX->Ixpvhv_arenaroot) #define PL_xpvhv_root (vTHX->Ixpvhv_root) +#define PL_xpviv_arenaroot (vTHX->Ixpviv_arenaroot) #define PL_xpviv_root (vTHX->Ixpviv_root) +#define PL_xpvlv_arenaroot (vTHX->Ixpvlv_arenaroot) #define PL_xpvlv_root (vTHX->Ixpvlv_root) +#define PL_xpvmg_arenaroot (vTHX->Ixpvmg_arenaroot) #define PL_xpvmg_root (vTHX->Ixpvmg_root) +#define PL_xpvnv_arenaroot (vTHX->Ixpvnv_arenaroot) #define PL_xpvnv_root (vTHX->Ixpvnv_root) +#define PL_xrv_arenaroot (vTHX->Ixrv_arenaroot) #define PL_xrv_root (vTHX->Ixrv_root) #define PL_yychar (vTHX->Iyychar) #define PL_yydebug (vTHX->Iyydebug) @@ -861,6 +895,7 @@ #define PL_argvoutgv (aTHXo->interp.Iargvoutgv) #define PL_basetime (aTHXo->interp.Ibasetime) #define PL_beginav (aTHXo->interp.Ibeginav) +#define PL_beginav_save (aTHXo->interp.Ibeginav_save) #define PL_bitcount (aTHXo->interp.Ibitcount) #define PL_bufend (aTHXo->interp.Ibufend) #define PL_bufptr (aTHXo->interp.Ibufptr) @@ -893,6 +928,7 @@ #define PL_doextract (aTHXo->interp.Idoextract) #define PL_doswitches (aTHXo->interp.Idoswitches) #define PL_dowarn (aTHXo->interp.Idowarn) +#define PL_dummy1_bincompat (aTHXo->interp.Idummy1_bincompat) #define PL_e_script (aTHXo->interp.Ie_script) #define PL_egid (aTHXo->interp.Iegid) #define PL_endav (aTHXo->interp.Iendav) @@ -911,6 +947,7 @@ #define PL_exitlistlen (aTHXo->interp.Iexitlistlen) #define PL_expect (aTHXo->interp.Iexpect) #define PL_fdpid (aTHXo->interp.Ifdpid) +#define PL_fdpid_mutex (aTHXo->interp.Ifdpid_mutex) #define PL_filemode (aTHXo->interp.Ifilemode) #define PL_forkprocess (aTHXo->interp.Iforkprocess) #define PL_formfeed (aTHXo->interp.Iformfeed) @@ -919,6 +956,7 @@ #define PL_gid (aTHXo->interp.Igid) #define PL_glob_index (aTHXo->interp.Iglob_index) #define PL_globalstash (aTHXo->interp.Iglobalstash) +#define PL_he_arenaroot (aTHXo->interp.Ihe_arenaroot) #define PL_he_root (aTHXo->interp.Ihe_root) #define PL_hintgv (aTHXo->interp.Ihintgv) #define PL_hints (aTHXo->interp.Ihints) @@ -987,9 +1025,10 @@ #define PL_nomemok (aTHXo->interp.Inomemok) #define PL_nthreads (aTHXo->interp.Inthreads) #define PL_nthreads_cond (aTHXo->interp.Inthreads_cond) +#define PL_nullstash (aTHXo->interp.Inullstash) #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) @@ -1041,6 +1080,7 @@ #define PL_subname (aTHXo->interp.Isubname) #define PL_sv_arenaroot (aTHXo->interp.Isv_arenaroot) #define PL_sv_count (aTHXo->interp.Isv_count) +#define PL_sv_lock_mutex (aTHXo->interp.Isv_lock_mutex) #define PL_sv_mutex (aTHXo->interp.Isv_mutex) #define PL_sv_no (aTHXo->interp.Isv_no) #define PL_sv_objcount (aTHXo->interp.Isv_objcount) @@ -1079,16 +1119,27 @@ #define PL_widesyscalls (aTHXo->interp.Iwidesyscalls) #define PL_xiv_arenaroot (aTHXo->interp.Ixiv_arenaroot) #define PL_xiv_root (aTHXo->interp.Ixiv_root) +#define PL_xnv_arenaroot (aTHXo->interp.Ixnv_arenaroot) #define PL_xnv_root (aTHXo->interp.Ixnv_root) +#define PL_xpv_arenaroot (aTHXo->interp.Ixpv_arenaroot) #define PL_xpv_root (aTHXo->interp.Ixpv_root) +#define PL_xpvav_arenaroot (aTHXo->interp.Ixpvav_arenaroot) #define PL_xpvav_root (aTHXo->interp.Ixpvav_root) +#define PL_xpvbm_arenaroot (aTHXo->interp.Ixpvbm_arenaroot) #define PL_xpvbm_root (aTHXo->interp.Ixpvbm_root) +#define PL_xpvcv_arenaroot (aTHXo->interp.Ixpvcv_arenaroot) #define PL_xpvcv_root (aTHXo->interp.Ixpvcv_root) +#define PL_xpvhv_arenaroot (aTHXo->interp.Ixpvhv_arenaroot) #define PL_xpvhv_root (aTHXo->interp.Ixpvhv_root) +#define PL_xpviv_arenaroot (aTHXo->interp.Ixpviv_arenaroot) #define PL_xpviv_root (aTHXo->interp.Ixpviv_root) +#define PL_xpvlv_arenaroot (aTHXo->interp.Ixpvlv_arenaroot) #define PL_xpvlv_root (aTHXo->interp.Ixpvlv_root) +#define PL_xpvmg_arenaroot (aTHXo->interp.Ixpvmg_arenaroot) #define PL_xpvmg_root (aTHXo->interp.Ixpvmg_root) +#define PL_xpvnv_arenaroot (aTHXo->interp.Ixpvnv_arenaroot) #define PL_xpvnv_root (aTHXo->interp.Ixpvnv_root) +#define PL_xrv_arenaroot (aTHXo->interp.Ixrv_arenaroot) #define PL_xrv_root (aTHXo->interp.Ixrv_root) #define PL_yychar (aTHXo->interp.Iyychar) #define PL_yydebug (aTHXo->interp.Iyydebug) @@ -1126,6 +1177,7 @@ #define PL_Iargvoutgv PL_argvoutgv #define PL_Ibasetime PL_basetime #define PL_Ibeginav PL_beginav +#define PL_Ibeginav_save PL_beginav_save #define PL_Ibitcount PL_bitcount #define PL_Ibufend PL_bufend #define PL_Ibufptr PL_bufptr @@ -1158,6 +1210,7 @@ #define PL_Idoextract PL_doextract #define PL_Idoswitches PL_doswitches #define PL_Idowarn PL_dowarn +#define PL_Idummy1_bincompat PL_dummy1_bincompat #define PL_Ie_script PL_e_script #define PL_Iegid PL_egid #define PL_Iendav PL_endav @@ -1176,6 +1229,7 @@ #define PL_Iexitlistlen PL_exitlistlen #define PL_Iexpect PL_expect #define PL_Ifdpid PL_fdpid +#define PL_Ifdpid_mutex PL_fdpid_mutex #define PL_Ifilemode PL_filemode #define PL_Iforkprocess PL_forkprocess #define PL_Iformfeed PL_formfeed @@ -1184,6 +1238,7 @@ #define PL_Igid PL_gid #define PL_Iglob_index PL_glob_index #define PL_Iglobalstash PL_globalstash +#define PL_Ihe_arenaroot PL_he_arenaroot #define PL_Ihe_root PL_he_root #define PL_Ihintgv PL_hintgv #define PL_Ihints PL_hints @@ -1252,9 +1307,10 @@ #define PL_Inomemok PL_nomemok #define PL_Inthreads PL_nthreads #define PL_Inthreads_cond PL_nthreads_cond +#define PL_Inullstash PL_nullstash #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 @@ -1306,6 +1362,7 @@ #define PL_Isubname PL_subname #define PL_Isv_arenaroot PL_sv_arenaroot #define PL_Isv_count PL_sv_count +#define PL_Isv_lock_mutex PL_sv_lock_mutex #define PL_Isv_mutex PL_sv_mutex #define PL_Isv_no PL_sv_no #define PL_Isv_objcount PL_sv_objcount @@ -1344,16 +1401,27 @@ #define PL_Iwidesyscalls PL_widesyscalls #define PL_Ixiv_arenaroot PL_xiv_arenaroot #define PL_Ixiv_root PL_xiv_root +#define PL_Ixnv_arenaroot PL_xnv_arenaroot #define PL_Ixnv_root PL_xnv_root +#define PL_Ixpv_arenaroot PL_xpv_arenaroot #define PL_Ixpv_root PL_xpv_root +#define PL_Ixpvav_arenaroot PL_xpvav_arenaroot #define PL_Ixpvav_root PL_xpvav_root +#define PL_Ixpvbm_arenaroot PL_xpvbm_arenaroot #define PL_Ixpvbm_root PL_xpvbm_root +#define PL_Ixpvcv_arenaroot PL_xpvcv_arenaroot #define PL_Ixpvcv_root PL_xpvcv_root +#define PL_Ixpvhv_arenaroot PL_xpvhv_arenaroot #define PL_Ixpvhv_root PL_xpvhv_root +#define PL_Ixpviv_arenaroot PL_xpviv_arenaroot #define PL_Ixpviv_root PL_xpviv_root +#define PL_Ixpvlv_arenaroot PL_xpvlv_arenaroot #define PL_Ixpvlv_root PL_xpvlv_root +#define PL_Ixpvmg_arenaroot PL_xpvmg_arenaroot #define PL_Ixpvmg_root PL_xpvmg_root +#define PL_Ixpvnv_arenaroot PL_xpvnv_arenaroot #define PL_Ixpvnv_root PL_xpvnv_root +#define PL_Ixrv_arenaroot PL_xrv_arenaroot #define PL_Ixrv_root PL_xrv_root #define PL_Iyychar PL_yychar #define PL_Iyydebug PL_yydebug @@ -1683,6 +1751,7 @@ #define no_modify PL_no_modify #define perl_destruct_level PL_perl_destruct_level #define perldb PL_perldb +#define ppaddr PL_ppaddr #define rsfp PL_rsfp #define rsfp_filters PL_rsfp_filters #define stack_base PL_stack_base diff --git a/contrib/perl5/ext/B/B.pm b/contrib/perl5/ext/B/B.pm index 4512d916e61e..c58e769a84d5 100644 --- a/contrib/perl5/ext/B/B.pm +++ b/contrib/perl5/ext/B/B.pm @@ -9,11 +9,17 @@ package B; use XSLoader (); require Exporter; @ISA = qw(Exporter); -@EXPORT_OK = qw(minus_c ppname + +# walkoptree_slow comes from B.pm (you are there), +# walkoptree comes from B.xs +@EXPORT_OK = qw(minus_c ppname save_BEGINs class peekop cast_I32 cstring cchar hash threadsv_names - main_root main_start main_cv svref_2object opnumber amagic_generation - walkoptree walkoptree_slow walkoptree_exec walksymtable - parents comppadlist sv_undef compile_stats timing_info init_av); + main_root main_start main_cv svref_2object opnumber + amagic_generation + walkoptree_slow walkoptree walkoptree_exec walksymtable + parents comppadlist sv_undef compile_stats timing_info + begin_av init_av end_av); + sub OPf_KIDS (); use strict; @B::SV::ISA = 'B::OBJECT'; @@ -54,6 +60,21 @@ use strict; package B::OBJECT; } +sub B::GV::SAFENAME { + my $name = (shift())->NAME; + + # The regex below corresponds to the isCONTROLVAR macro + # from toke.c + + $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^".chr(64 ^ ord($1))/e; + return $name; +} + +sub B::IV::int_value { + my ($self) = @_; + return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV); +} + my $debug; my $op_count = 0; my @parents = (); @@ -125,6 +146,7 @@ sub objsym { sub walkoptree_exec { my ($op, $method, $level) = @_; + $level ||= 0; my ($sym, $ppname); my $prefix = " " x $level; for (; $$op; $op = $op->next) { @@ -184,7 +206,7 @@ sub walksymtable { *glob = "*main::".$prefix.$sym; if ($sym =~ /::$/) { $sym = $prefix . $sym; - if ($sym ne "main::" && &$recurse($sym)) { + if ($sym ne "main::" && $sym ne "::" && &$recurse($sym)) { walksymtable(\%glob, $method, $recurse, $sym); } } else { @@ -326,8 +348,22 @@ C (corresponding to the C function C). =item IV +Returns the value of the IV, I. This will be misleading +if C. Perhaps you want the +C method instead? + =item IVX +=item UVX + +=item int_value + +This method returns the value of the IV as an integer. +It differs from C in that it returns the correct +value regardless of whether it's stored signed or +unsigned. + =item needs64bits =item packiv @@ -358,6 +394,22 @@ C (corresponding to the C function C). =item PV +This method is the one you usually want. It constructs a +string using the length and offset information in the struct: +for ordinary scalars it will return the string that you'd see +from Perl, even if it contains null characters. + +=item PVX + +This method is less often useful. It assumes that the string +stored in the struct is null-terminated, and disregards the +length information. + +It is the appropriate method to use if you need to get the name +of a lexical variable from a padname array. Lexical variable names +are always stored with a null terminator, and the length field +(SvCUR) is overloaded for other purposes and can't be relied on here. + =back =head2 B::PVMG METHODS @@ -426,6 +478,21 @@ This method returns TRUE if the GP field of the GV is NULL. =item NAME +=item SAFENAME + +This method returns the name of the glob, but if the first +character of the name is a control character, then it converts +it to ^X first, so that *^G would return "^G" rather than "\cG". + +It's useful if you want to print out the name of a variable. +If you restrict yourself to globs which exist at compile-time +then the result ought to be unambiguous, because code like +C<${"^G"} = 1> is compiled as two ops - a constant string and +a dereference (rv2gv) - so that the glob is created at runtime. + +If you're working with globs at runtime, and need to disambiguate +*^G from *{"^G"}, then you should use the raw NAME method. + =item STASH =item SV diff --git a/contrib/perl5/ext/B/B.xs b/contrib/perl5/ext/B/B.xs index 9e2985582a15..100574752115 100644 --- a/contrib/perl5/ext/B/B.xs +++ b/contrib/perl5/ext/B/B.xs @@ -81,7 +81,7 @@ static char *opclassnames[] = { static int walkoptree_debug = 0; /* Flag for walkoptree debug hook */ -static SV *specialsv_list[4]; +static SV *specialsv_list[6]; static opclass cc_opclass(pTHX_ OP *o) @@ -386,11 +386,15 @@ BOOT: specialsv_list[1] = &PL_sv_undef; specialsv_list[2] = &PL_sv_yes; specialsv_list[3] = &PL_sv_no; + specialsv_list[4] = pWARN_ALL; + specialsv_list[5] = pWARN_NONE; #include "defsubs.h" } #define B_main_cv() PL_main_cv #define B_init_av() PL_initav +#define B_begin_av() PL_beginav_save +#define B_end_av() PL_endav #define B_main_root() PL_main_root #define B_main_start() PL_main_start #define B_amagic_generation() PL_amagic_generation @@ -402,6 +406,12 @@ BOOT: B::AV B_init_av() +B::AV +B_begin_av() + +B::AV +B_end_av() + B::CV B_main_cv() @@ -515,6 +525,11 @@ minus_c() CODE: PL_minus_c = TRUE; +void +save_BEGINs() + CODE: + PL_minus_c |= 0x10; + SV * cstring(sv) SV * sv @@ -567,11 +582,12 @@ char * OP_name(o) B::OP o CODE: - ST(0) = sv_newmortal(); - sv_setpv(ST(0), PL_op_name[o->op_type]); + RETVAL = PL_op_name[o->op_type]; + OUTPUT: + RETVAL -char * +void OP_ppaddr(o) B::OP o PREINIT: @@ -633,13 +649,20 @@ B::OP LOGOP_other(o) B::LOGOP o -#define LISTOP_children(o) o->op_children - MODULE = B PACKAGE = B::LISTOP PREFIX = LISTOP_ U32 LISTOP_children(o) B::LISTOP o + OP * kid = NO_INIT + int i = NO_INIT + CODE: + i = 0; + for (kid = o->op_first; kid; kid = kid->op_sibling) + i++; + RETVAL = i; + OUTPUT: + RETVAL #define PMOP_pmreplroot(o) o->op_pmreplroot #define PMOP_pmreplstart(o) o->op_pmreplstart @@ -693,8 +716,8 @@ PMOP_precomp(o) if (rx) sv_setpvn(ST(0), rx->precomp, rx->prelen); -#define SVOP_sv(o) cSVOPo->op_sv -#define SVOP_gv(o) ((GV*)cSVOPo->op_sv) +#define SVOP_sv(o) cSVOPo->op_sv +#define SVOP_gv(o) ((GV*)cSVOPo->op_sv) MODULE = B PACKAGE = B::SVOP PREFIX = SVOP_ @@ -862,11 +885,11 @@ packiv(sv) MODULE = B PACKAGE = B::NV PREFIX = Sv -double +NV SvNV(sv) B::NV sv -double +NV SvNVX(sv) B::NV sv @@ -878,6 +901,10 @@ SvRV(sv) MODULE = B PACKAGE = B::PV PREFIX = Sv +char* +SvPVX(sv) + B::PV sv + void SvPV(sv) B::PV sv @@ -1210,7 +1237,7 @@ CvXSUBANY(cv) MODULE = B PACKAGE = B::CV -U8 +U16 CvFLAGS(cv) B::CV cv @@ -1251,7 +1278,7 @@ HvARRAY(hv) I32 len; (void)hv_iterinit(hv); EXTEND(sp, HvKEYS(hv) * 2); - while (sv = hv_iternextsv(hv, &key, &len)) { + while ((sv = hv_iternextsv(hv, &key, &len))) { PUSHs(newSVpvn(key, len)); PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv)); } diff --git a/contrib/perl5/ext/B/B/Asmdata.pm b/contrib/perl5/ext/B/B/Asmdata.pm index bc0eda935b7a..dc176be9626e 100644 --- a/contrib/perl5/ext/B/B/Asmdata.pm +++ b/contrib/perl5/ext/B/B/Asmdata.pm @@ -15,7 +15,7 @@ use Exporter; our(%insn_data, @insn_name, @optype, @specialsv_name); @optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP); -@specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no); +@specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no pWARN_ALL pWARN_NONE); # XXX insn_data is initialised this way because with a large # %insn_data = (foo => [...], bar => [...], ...) initialiser @@ -27,93 +27,93 @@ $insn_data{ldsv} = [1, \&PUT_svindex, "GET_svindex"]; $insn_data{ldop} = [2, \&PUT_opindex, "GET_opindex"]; $insn_data{stsv} = [3, \&PUT_U32, "GET_U32"]; $insn_data{stop} = [4, \&PUT_U32, "GET_U32"]; -$insn_data{ldspecsv} = [5, \&PUT_U8, "GET_U8"]; -$insn_data{newsv} = [6, \&PUT_U8, "GET_U8"]; -$insn_data{newop} = [7, \&PUT_U8, "GET_U8"]; -$insn_data{newopn} = [8, \&PUT_U8, "GET_U8"]; -$insn_data{newpv} = [9, \&PUT_PV, "GET_PV"]; -$insn_data{pv_cur} = [11, \&PUT_U32, "GET_U32"]; -$insn_data{pv_free} = [12, \&PUT_none, "GET_none"]; -$insn_data{sv_upgrade} = [13, \&PUT_U8, "GET_U8"]; -$insn_data{sv_refcnt} = [14, \&PUT_U32, "GET_U32"]; -$insn_data{sv_refcnt_add} = [15, \&PUT_I32, "GET_I32"]; -$insn_data{sv_flags} = [16, \&PUT_U32, "GET_U32"]; -$insn_data{xrv} = [17, \&PUT_svindex, "GET_svindex"]; -$insn_data{xpv} = [18, \&PUT_none, "GET_none"]; -$insn_data{xiv32} = [19, \&PUT_I32, "GET_I32"]; -$insn_data{xiv64} = [20, \&PUT_IV64, "GET_IV64"]; -$insn_data{xnv} = [21, \&PUT_NV, "GET_NV"]; -$insn_data{xlv_targoff} = [22, \&PUT_U32, "GET_U32"]; -$insn_data{xlv_targlen} = [23, \&PUT_U32, "GET_U32"]; -$insn_data{xlv_targ} = [24, \&PUT_svindex, "GET_svindex"]; -$insn_data{xlv_type} = [25, \&PUT_U8, "GET_U8"]; -$insn_data{xbm_useful} = [26, \&PUT_I32, "GET_I32"]; -$insn_data{xbm_previous} = [27, \&PUT_U16, "GET_U16"]; -$insn_data{xbm_rare} = [28, \&PUT_U8, "GET_U8"]; -$insn_data{xfm_lines} = [29, \&PUT_I32, "GET_I32"]; -$insn_data{xio_lines} = [30, \&PUT_I32, "GET_I32"]; -$insn_data{xio_page} = [31, \&PUT_I32, "GET_I32"]; -$insn_data{xio_page_len} = [32, \&PUT_I32, "GET_I32"]; -$insn_data{xio_lines_left} = [33, \&PUT_I32, "GET_I32"]; -$insn_data{xio_top_name} = [34, \&PUT_pvcontents, "GET_pvcontents"]; -$insn_data{xio_top_gv} = [36, \&PUT_svindex, "GET_svindex"]; -$insn_data{xio_fmt_name} = [37, \&PUT_pvcontents, "GET_pvcontents"]; -$insn_data{xio_fmt_gv} = [38, \&PUT_svindex, "GET_svindex"]; -$insn_data{xio_bottom_name} = [39, \&PUT_pvcontents, "GET_pvcontents"]; -$insn_data{xio_bottom_gv} = [40, \&PUT_svindex, "GET_svindex"]; -$insn_data{xio_subprocess} = [41, \&PUT_U16, "GET_U16"]; -$insn_data{xio_type} = [42, \&PUT_U8, "GET_U8"]; -$insn_data{xio_flags} = [43, \&PUT_U8, "GET_U8"]; -$insn_data{xcv_stash} = [44, \&PUT_svindex, "GET_svindex"]; -$insn_data{xcv_start} = [45, \&PUT_opindex, "GET_opindex"]; -$insn_data{xcv_root} = [46, \&PUT_opindex, "GET_opindex"]; -$insn_data{xcv_gv} = [47, \&PUT_svindex, "GET_svindex"]; -$insn_data{xcv_file} = [48, \&PUT_pvcontents, "GET_pvcontents"]; -$insn_data{xcv_depth} = [49, \&PUT_I32, "GET_I32"]; -$insn_data{xcv_padlist} = [50, \&PUT_svindex, "GET_svindex"]; -$insn_data{xcv_outside} = [51, \&PUT_svindex, "GET_svindex"]; -$insn_data{xcv_flags} = [52, \&PUT_U16, "GET_U16"]; -$insn_data{av_extend} = [53, \&PUT_I32, "GET_I32"]; -$insn_data{av_push} = [54, \&PUT_svindex, "GET_svindex"]; -$insn_data{xav_fill} = [55, \&PUT_I32, "GET_I32"]; -$insn_data{xav_max} = [56, \&PUT_I32, "GET_I32"]; -$insn_data{xav_flags} = [57, \&PUT_U8, "GET_U8"]; -$insn_data{xhv_riter} = [58, \&PUT_I32, "GET_I32"]; -$insn_data{xhv_name} = [59, \&PUT_pvcontents, "GET_pvcontents"]; -$insn_data{hv_store} = [60, \&PUT_svindex, "GET_svindex"]; -$insn_data{sv_magic} = [61, \&PUT_U8, "GET_U8"]; -$insn_data{mg_obj} = [62, \&PUT_svindex, "GET_svindex"]; -$insn_data{mg_private} = [63, \&PUT_U16, "GET_U16"]; -$insn_data{mg_flags} = [64, \&PUT_U8, "GET_U8"]; -$insn_data{mg_pv} = [65, \&PUT_pvcontents, "GET_pvcontents"]; -$insn_data{xmg_stash} = [66, \&PUT_svindex, "GET_svindex"]; -$insn_data{gv_fetchpv} = [67, \&PUT_strconst, "GET_strconst"]; -$insn_data{gv_stashpv} = [68, \&PUT_strconst, "GET_strconst"]; -$insn_data{gp_sv} = [69, \&PUT_svindex, "GET_svindex"]; -$insn_data{gp_refcnt} = [70, \&PUT_U32, "GET_U32"]; -$insn_data{gp_refcnt_add} = [71, \&PUT_I32, "GET_I32"]; -$insn_data{gp_av} = [72, \&PUT_svindex, "GET_svindex"]; -$insn_data{gp_hv} = [73, \&PUT_svindex, "GET_svindex"]; -$insn_data{gp_cv} = [74, \&PUT_svindex, "GET_svindex"]; -$insn_data{gp_file} = [75, \&PUT_pvcontents, "GET_pvcontents"]; -$insn_data{gp_io} = [76, \&PUT_svindex, "GET_svindex"]; -$insn_data{gp_form} = [77, \&PUT_svindex, "GET_svindex"]; -$insn_data{gp_cvgen} = [78, \&PUT_U32, "GET_U32"]; -$insn_data{gp_line} = [79, \&PUT_U16, "GET_U16"]; -$insn_data{gp_share} = [80, \&PUT_svindex, "GET_svindex"]; -$insn_data{xgv_flags} = [81, \&PUT_U8, "GET_U8"]; -$insn_data{op_next} = [82, \&PUT_opindex, "GET_opindex"]; -$insn_data{op_sibling} = [83, \&PUT_opindex, "GET_opindex"]; -$insn_data{op_ppaddr} = [84, \&PUT_strconst, "GET_strconst"]; -$insn_data{op_targ} = [85, \&PUT_U32, "GET_U32"]; -$insn_data{op_type} = [86, \&PUT_U16, "GET_U16"]; -$insn_data{op_seq} = [87, \&PUT_U16, "GET_U16"]; -$insn_data{op_flags} = [88, \&PUT_U8, "GET_U8"]; -$insn_data{op_private} = [89, \&PUT_U8, "GET_U8"]; -$insn_data{op_first} = [90, \&PUT_opindex, "GET_opindex"]; -$insn_data{op_last} = [91, \&PUT_opindex, "GET_opindex"]; -$insn_data{op_other} = [92, \&PUT_opindex, "GET_opindex"]; -$insn_data{op_children} = [93, \&PUT_U32, "GET_U32"]; +$insn_data{stpv} = [5, \&PUT_U32, "GET_U32"]; +$insn_data{ldspecsv} = [6, \&PUT_U8, "GET_U8"]; +$insn_data{newsv} = [7, \&PUT_U8, "GET_U8"]; +$insn_data{newop} = [8, \&PUT_U8, "GET_U8"]; +$insn_data{newopn} = [9, \&PUT_U8, "GET_U8"]; +$insn_data{newpv} = [11, \&PUT_PV, "GET_PV"]; +$insn_data{pv_cur} = [12, \&PUT_U32, "GET_U32"]; +$insn_data{pv_free} = [13, \&PUT_none, "GET_none"]; +$insn_data{sv_upgrade} = [14, \&PUT_U8, "GET_U8"]; +$insn_data{sv_refcnt} = [15, \&PUT_U32, "GET_U32"]; +$insn_data{sv_refcnt_add} = [16, \&PUT_I32, "GET_I32"]; +$insn_data{sv_flags} = [17, \&PUT_U32, "GET_U32"]; +$insn_data{xrv} = [18, \&PUT_svindex, "GET_svindex"]; +$insn_data{xpv} = [19, \&PUT_none, "GET_none"]; +$insn_data{xiv32} = [20, \&PUT_I32, "GET_I32"]; +$insn_data{xiv64} = [21, \&PUT_IV64, "GET_IV64"]; +$insn_data{xnv} = [22, \&PUT_NV, "GET_NV"]; +$insn_data{xlv_targoff} = [23, \&PUT_U32, "GET_U32"]; +$insn_data{xlv_targlen} = [24, \&PUT_U32, "GET_U32"]; +$insn_data{xlv_targ} = [25, \&PUT_svindex, "GET_svindex"]; +$insn_data{xlv_type} = [26, \&PUT_U8, "GET_U8"]; +$insn_data{xbm_useful} = [27, \&PUT_I32, "GET_I32"]; +$insn_data{xbm_previous} = [28, \&PUT_U16, "GET_U16"]; +$insn_data{xbm_rare} = [29, \&PUT_U8, "GET_U8"]; +$insn_data{xfm_lines} = [30, \&PUT_I32, "GET_I32"]; +$insn_data{xio_lines} = [31, \&PUT_I32, "GET_I32"]; +$insn_data{xio_page} = [32, \&PUT_I32, "GET_I32"]; +$insn_data{xio_page_len} = [33, \&PUT_I32, "GET_I32"]; +$insn_data{xio_lines_left} = [34, \&PUT_I32, "GET_I32"]; +$insn_data{xio_top_name} = [36, \&PUT_pvcontents, "GET_pvcontents"]; +$insn_data{xio_top_gv} = [37, \&PUT_svindex, "GET_svindex"]; +$insn_data{xio_fmt_name} = [38, \&PUT_pvcontents, "GET_pvcontents"]; +$insn_data{xio_fmt_gv} = [39, \&PUT_svindex, "GET_svindex"]; +$insn_data{xio_bottom_name} = [40, \&PUT_pvcontents, "GET_pvcontents"]; +$insn_data{xio_bottom_gv} = [41, \&PUT_svindex, "GET_svindex"]; +$insn_data{xio_subprocess} = [42, \&PUT_U16, "GET_U16"]; +$insn_data{xio_type} = [43, \&PUT_U8, "GET_U8"]; +$insn_data{xio_flags} = [44, \&PUT_U8, "GET_U8"]; +$insn_data{xcv_stash} = [45, \&PUT_svindex, "GET_svindex"]; +$insn_data{xcv_start} = [46, \&PUT_opindex, "GET_opindex"]; +$insn_data{xcv_root} = [47, \&PUT_opindex, "GET_opindex"]; +$insn_data{xcv_gv} = [48, \&PUT_svindex, "GET_svindex"]; +$insn_data{xcv_file} = [49, \&PUT_pvindex, "GET_pvindex"]; +$insn_data{xcv_depth} = [50, \&PUT_I32, "GET_I32"]; +$insn_data{xcv_padlist} = [51, \&PUT_svindex, "GET_svindex"]; +$insn_data{xcv_outside} = [52, \&PUT_svindex, "GET_svindex"]; +$insn_data{xcv_flags} = [53, \&PUT_U16, "GET_U16"]; +$insn_data{av_extend} = [54, \&PUT_I32, "GET_I32"]; +$insn_data{av_push} = [55, \&PUT_svindex, "GET_svindex"]; +$insn_data{xav_fill} = [56, \&PUT_I32, "GET_I32"]; +$insn_data{xav_max} = [57, \&PUT_I32, "GET_I32"]; +$insn_data{xav_flags} = [58, \&PUT_U8, "GET_U8"]; +$insn_data{xhv_riter} = [59, \&PUT_I32, "GET_I32"]; +$insn_data{xhv_name} = [60, \&PUT_pvcontents, "GET_pvcontents"]; +$insn_data{hv_store} = [61, \&PUT_svindex, "GET_svindex"]; +$insn_data{sv_magic} = [62, \&PUT_U8, "GET_U8"]; +$insn_data{mg_obj} = [63, \&PUT_svindex, "GET_svindex"]; +$insn_data{mg_private} = [64, \&PUT_U16, "GET_U16"]; +$insn_data{mg_flags} = [65, \&PUT_U8, "GET_U8"]; +$insn_data{mg_pv} = [66, \&PUT_pvcontents, "GET_pvcontents"]; +$insn_data{xmg_stash} = [67, \&PUT_svindex, "GET_svindex"]; +$insn_data{gv_fetchpv} = [68, \&PUT_strconst, "GET_strconst"]; +$insn_data{gv_stashpv} = [69, \&PUT_strconst, "GET_strconst"]; +$insn_data{gp_sv} = [70, \&PUT_svindex, "GET_svindex"]; +$insn_data{gp_refcnt} = [71, \&PUT_U32, "GET_U32"]; +$insn_data{gp_refcnt_add} = [72, \&PUT_I32, "GET_I32"]; +$insn_data{gp_av} = [73, \&PUT_svindex, "GET_svindex"]; +$insn_data{gp_hv} = [74, \&PUT_svindex, "GET_svindex"]; +$insn_data{gp_cv} = [75, \&PUT_svindex, "GET_svindex"]; +$insn_data{gp_file} = [76, \&PUT_pvindex, "GET_pvindex"]; +$insn_data{gp_io} = [77, \&PUT_svindex, "GET_svindex"]; +$insn_data{gp_form} = [78, \&PUT_svindex, "GET_svindex"]; +$insn_data{gp_cvgen} = [79, \&PUT_U32, "GET_U32"]; +$insn_data{gp_line} = [80, \&PUT_U16, "GET_U16"]; +$insn_data{gp_share} = [81, \&PUT_svindex, "GET_svindex"]; +$insn_data{xgv_flags} = [82, \&PUT_U8, "GET_U8"]; +$insn_data{op_next} = [83, \&PUT_opindex, "GET_opindex"]; +$insn_data{op_sibling} = [84, \&PUT_opindex, "GET_opindex"]; +$insn_data{op_ppaddr} = [85, \&PUT_strconst, "GET_strconst"]; +$insn_data{op_targ} = [86, \&PUT_U32, "GET_U32"]; +$insn_data{op_type} = [87, \&PUT_U16, "GET_U16"]; +$insn_data{op_seq} = [88, \&PUT_U16, "GET_U16"]; +$insn_data{op_flags} = [89, \&PUT_U8, "GET_U8"]; +$insn_data{op_private} = [90, \&PUT_U8, "GET_U8"]; +$insn_data{op_first} = [91, \&PUT_opindex, "GET_opindex"]; +$insn_data{op_last} = [92, \&PUT_opindex, "GET_opindex"]; +$insn_data{op_other} = [93, \&PUT_opindex, "GET_opindex"]; $insn_data{op_pmreplroot} = [94, \&PUT_opindex, "GET_opindex"]; $insn_data{op_pmreplrootgv} = [95, \&PUT_svindex, "GET_svindex"]; $insn_data{op_pmreplstart} = [96, \&PUT_opindex, "GET_opindex"]; @@ -128,9 +128,9 @@ $insn_data{op_pv_tr} = [104, \&PUT_op_tr_array, "GET_op_tr_array"]; $insn_data{op_redoop} = [105, \&PUT_opindex, "GET_opindex"]; $insn_data{op_nextop} = [106, \&PUT_opindex, "GET_opindex"]; $insn_data{op_lastop} = [107, \&PUT_opindex, "GET_opindex"]; -$insn_data{cop_label} = [108, \&PUT_pvcontents, "GET_pvcontents"]; -$insn_data{cop_stashpv} = [109, \&PUT_pvcontents, "GET_pvcontents"]; -$insn_data{cop_file} = [110, \&PUT_pvcontents, "GET_pvcontents"]; +$insn_data{cop_label} = [108, \&PUT_pvindex, "GET_pvindex"]; +$insn_data{cop_stashpv} = [109, \&PUT_pvindex, "GET_pvindex"]; +$insn_data{cop_file} = [110, \&PUT_pvindex, "GET_pvindex"]; $insn_data{cop_seq} = [111, \&PUT_U32, "GET_U32"]; $insn_data{cop_arybase} = [112, \&PUT_I32, "GET_I32"]; $insn_data{cop_line} = [113, \&PUT_U16, "GET_U16"]; @@ -138,6 +138,9 @@ $insn_data{cop_warnings} = [114, \&PUT_svindex, "GET_svindex"]; $insn_data{main_start} = [115, \&PUT_opindex, "GET_opindex"]; $insn_data{main_root} = [116, \&PUT_opindex, "GET_opindex"]; $insn_data{curpad} = [117, \&PUT_svindex, "GET_svindex"]; +$insn_data{push_begin} = [118, \&PUT_svindex, "GET_svindex"]; +$insn_data{push_init} = [119, \&PUT_svindex, "GET_svindex"]; +$insn_data{push_end} = [120, \&PUT_svindex, "GET_svindex"]; my ($insn_name, $insn_data); while (($insn_name, $insn_data) = each %insn_data) { diff --git a/contrib/perl5/ext/B/B/Assembler.pm b/contrib/perl5/ext/B/B/Assembler.pm index 6c51a9ad3e3b..5e798ce485d4 100644 --- a/contrib/perl5/ext/B/B/Assembler.pm +++ b/contrib/perl5/ext/B/B/Assembler.pm @@ -4,14 +4,17 @@ # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the README file. + package B::Assembler; use Exporter; use B qw(ppname); use B::Asmdata qw(%insn_data @insn_name); +use Config qw(%Config); +require ByteLoader; # we just need its $VERSIOM @ISA = qw(Exporter); -@EXPORT_OK = qw(assemble_fh assemble_insn strip_comments - parse_statement uncstring); +@EXPORT_OK = qw(assemble_fh newasm endasm assemble); +$VERSION = 0.02; use strict; my %opnumber; @@ -20,7 +23,7 @@ for ($i = 0; defined($opname = ppname($i)); $i++) { $opnumber{$opname} = $i; } -my ($linenum, $errors); +my($linenum, $errors, $out); # global state, set up by newasm sub error { my $str = shift; @@ -49,13 +52,15 @@ sub B::Asmdata::PUT_U8 { return $c; } -sub B::Asmdata::PUT_U16 { pack("n", $_[0]) } -sub B::Asmdata::PUT_U32 { pack("N", $_[0]) } -sub B::Asmdata::PUT_I32 { pack("N", $_[0]) } -sub B::Asmdata::PUT_NV { sprintf("%lf\0", $_[0]) } -sub B::Asmdata::PUT_objindex { pack("N", $_[0]) } # could allow names here +sub B::Asmdata::PUT_U16 { pack("S", $_[0]) } +sub B::Asmdata::PUT_U32 { pack("L", $_[0]) } +sub B::Asmdata::PUT_I32 { pack("L", $_[0]) } +sub B::Asmdata::PUT_NV { sprintf("%s\0", $_[0]) } # "%lf" looses precision and pack('d',...) + # may not even be portable between compilers +sub B::Asmdata::PUT_objindex { pack("L", $_[0]) } # could allow names here sub B::Asmdata::PUT_svindex { &B::Asmdata::PUT_objindex } sub B::Asmdata::PUT_opindex { &B::Asmdata::PUT_objindex } +sub B::Asmdata::PUT_pvindex { &B::Asmdata::PUT_objindex } sub B::Asmdata::PUT_strconst { my $arg = shift; @@ -79,7 +84,7 @@ sub B::Asmdata::PUT_PV { my $arg = shift; $arg = uncstring($arg); error "bad string argument: $arg" unless defined($arg); - return pack("N", length($arg)) . $arg; + return pack("L", length($arg)) . $arg; } sub B::Asmdata::PUT_comment_t { my $arg = shift; @@ -90,7 +95,7 @@ sub B::Asmdata::PUT_comment_t { } return $arg . "\n"; } -sub B::Asmdata::PUT_double { sprintf("%s\0", $_[0]) } +sub B::Asmdata::PUT_double { sprintf("%s\0", $_[0]) } # see PUT_NV above sub B::Asmdata::PUT_none { my $arg = shift; error "extraneous argument: $arg" if defined $arg; @@ -103,12 +108,12 @@ sub B::Asmdata::PUT_op_tr_array { error "wrong number of arguments to op_tr_array"; @ary = (0) x 256; } - return pack("n256", @ary); + return pack("S256", @ary); } # XXX Check this works sub B::Asmdata::PUT_IV64 { my $arg = shift; - return pack("NN", $arg >> 32, $arg & 0xffffffff); + return pack("LL", $arg >> 32, $arg & 0xffffffff); } my %unesc = (n => "\n", r => "\r", t => "\t", a => "\a", @@ -138,6 +143,24 @@ sub strip_comments { return $stmt; } +# create the ByteCode header: magic, archname, ByteLoader $VERSION, ivsize, +# ptrsize, byteorder +# nvtype is irrelevant (floats are stored as strings) +# byteorder is strconst not U32 because of varying size issues + +sub gen_header { + my $header = ""; + + $header .= B::Asmdata::PUT_U32(0x43424c50); # 'PLBC' + $header .= B::Asmdata::PUT_strconst('"' . $Config{archname}. '"'); + $header .= B::Asmdata::PUT_strconst(qq["$ByteLoader::VERSION"]); + $header .= B::Asmdata::PUT_U32($Config{ivsize}); + $header .= B::Asmdata::PUT_U32($Config{ptrsize}); + $header .= B::Asmdata::PUT_strconst(sprintf(qq["0x%s"], $Config{byteorder})); + + $header; +} + sub parse_statement { my $stmt = shift; my ($insn, $arg) = $stmt =~ m{ @@ -183,27 +206,52 @@ sub assemble_insn { sub assemble_fh { my ($fh, $out) = @_; - my ($line, $insn, $arg); - $linenum = 0; - $errors = 0; + my $line; + my $asm = newasm($out); while ($line = <$fh>) { - $linenum++; - chomp $line; - if ($debug) { - my $quotedline = $line; - $quotedline =~ s/\\/\\\\/g; - $quotedline =~ s/"/\\"/g; - &$out(assemble_insn("comment", qq("$quotedline"))); - } - $line = strip_comments($line) or next; - ($insn, $arg) = parse_statement($line); - &$out(assemble_insn($insn, $arg)); - if ($debug) { - &$out(assemble_insn("nop", undef)); - } + assemble($line); } + endasm(); +} + +sub newasm { + my($outsub) = @_; + + die "Invalid printing routine for B::Assembler\n" unless ref $outsub eq 'CODE'; + die <(gen_header()); +} + +sub endasm { if ($errors) { - die "Assembly failed with $errors error(s)\n"; + die "There were $errors assembly errors\n"; + } + $linenum = $errors = $out = 0; +} + +sub assemble { + my($line) = @_; + my ($insn, $arg); + $linenum++; + chomp $line; + if ($debug) { + my $quotedline = $line; + $quotedline =~ s/\\/\\\\/g; + $quotedline =~ s/"/\\"/g; + $out->(assemble_insn("comment", qq("$quotedline"))); + } + $line = strip_comments($line) or next; + ($insn, $arg) = parse_statement($line); + $out->(assemble_insn($insn, $arg)); + if ($debug) { + $out->(assemble_insn("nop", undef)); } } @@ -217,14 +265,21 @@ B::Assembler - Assemble Perl bytecode =head1 SYNOPSIS - use Assembler; + use B::Assembler qw(newasm endasm assemble); + newasm(\&printsub); # sets up for assembly + assemble($buf); # assembles one line + endasm(); # closes down + + use B::Assembler qw(assemble_fh); + assemble_fh($fh, \&printsub); # assemble everything in $fh =head1 DESCRIPTION See F. -=head1 AUTHOR +=head1 AUTHORS Malcolm Beattie, C +Per-statement interface by Benjamin Stuhl, C =cut diff --git a/contrib/perl5/ext/B/B/Bytecode.pm b/contrib/perl5/ext/B/B/Bytecode.pm index 27003b6bd0b2..54d7c533c868 100644 --- a/contrib/perl5/ext/B/B/Bytecode.pm +++ b/contrib/perl5/ext/B/B/Bytecode.pm @@ -6,16 +6,18 @@ # License or the Artistic License, as specified in the README file. # package B::Bytecode; + use strict; use Carp; -use IO::File; - -use B qw(minus_c main_cv main_root main_start comppadlist +use B qw(main_cv main_root main_start comppadlist class peekop walkoptree svref_2object cstring walksymtable - SVf_POK SVp_POK SVf_IOK SVp_IOK + init_av begin_av end_av + SVf_POK SVp_POK SVf_IOK SVp_IOK SVf_NOK SVp_NOK + SVf_READONLY GVf_IMPORTED_AV GVf_IMPORTED_CV GVf_IMPORTED_HV + GVf_IMPORTED_SV SVTYPEMASK ); use B::Asmdata qw(@optype @specialsv_name); -use B::Assembler qw(assemble_fh); +use B::Assembler qw(newasm endasm assemble); my %optype_enum; my $i; @@ -31,41 +33,76 @@ sub POK () { SVf_POK|SVp_POK } # XXX Shouldn't be hardwired sub IOK () { SVf_IOK|SVp_IOK } -my ($verbose, $module_only, $no_assemble, $debug_bc, $debug_cv); -my $assembler_pid; +# Following is SVf_NOK|SVp_NOK +# XXX Shouldn't be hardwired +sub NOK () { SVf_NOK|SVp_NOK } + +# nonexistant flags (see B::GV::bytecode for usage) +sub GVf_IMPORTED_IO () { 0; } +sub GVf_IMPORTED_FORM () { 0; } + +my ($verbose, $no_assemble, $debug_bc, $debug_cv); +my @packages; # list of packages to compile + +sub asm (@) { # print replacement that knows about assembling + if ($no_assemble) { + print @_; + } else { + my $buf = join '', @_; + assemble($_) for (split /\n/, $buf); + } +} + +sub asmf (@) { # printf replacement that knows about assembling + if ($no_assemble) { + printf shift(), @_; + } else { + my $format = shift; + my $buf = sprintf $format, @_; + assemble($_) for (split /\n/, $buf); + } +} # Optimisation options. On the command line, use hyphens instead of # underscores for compatibility with gcc-style options. We use # underscores here because they are OK in (strict) barewords. -my ($strip_syntree, $compress_nullops, $omit_seq, $bypass_nullops); -my %optimise = (strip_syntax_tree => \$strip_syntree, - compress_nullops => \$compress_nullops, +my ($compress_nullops, $omit_seq, $bypass_nullops); +my %optimise = (compress_nullops => \$compress_nullops, omit_sequence_numbers => \$omit_seq, bypass_nullops => \$bypass_nullops); +my $strip_syntree; # this is left here in case stripping the + # syntree ever becomes safe again + # -- BKS, June 2000 + my $nextix = 0; my %symtable; # maps object addresses to object indices. # Filled in at allocation (newsv/newop) time. + my %saved; # maps object addresses (for SVish classes) to "saved yet?" # flag. Set at FOO::bytecode time usually by SV::bytecode. # Manipulated via saved(), mark_saved(), unmark_saved(). +my %strtable; # maps shared strings to object indices + # Filled in at allocation (pvix) time + my $svix = -1; # we keep track of when the sv register contains an element # of the object table to avoid unnecessary repeated # consecutive ldsv instructions. + my $opix = -1; # Ditto for the op register. sub ldsv { my $ix = shift; if ($ix != $svix) { - print "ldsv $ix\n"; + asm "ldsv $ix\n"; $svix = $ix; } } sub stsv { my $ix = shift; - print "stsv $ix\n"; + asm "stsv $ix\n"; $svix = $ix; } @@ -76,14 +113,14 @@ sub set_svix { sub ldop { my $ix = shift; if ($ix != $opix) { - print "ldop $ix\n"; + asm "ldop $ix\n"; $opix = $ix; } } sub stop { my $ix = shift; - print "stop $ix\n"; + asm "stop $ix\n"; $opix = $ix; } @@ -100,12 +137,29 @@ sub pvstring { } } +sub nv { + # print full precision + my $str = sprintf "%.40f", $_[0]; + $str =~ s/0+$//; # remove trailing zeros + $str =~ s/\.$/.0/; + return $str; +} + sub saved { $saved{${$_[0]}} } sub mark_saved { $saved{${$_[0]}} = 1 } sub unmark_saved { $saved{${$_[0]}} = 0 } sub debug { $debug_bc = shift } +sub pvix { # save a shared PV (mainly for COPs) + return $strtable{$_[0]} if defined($strtable{$_[0]}); + asmf "newpv %s\n", pvstring($_[0]); + my $ix = $nextix++; + $strtable{$_[0]} = $ix; + asmf "stpv %d\n", $ix; + return $ix; +} + sub B::OBJECT::nyi { my $obj = shift; warn sprintf("bytecode save method for %s (0x%x) not yet implemented\n", @@ -129,7 +183,7 @@ sub B::OBJECT::objix { sub B::SV::newix { my ($sv, $ix) = @_; - printf "newsv %d\t# %s\n", $sv->FLAGS & 0xf, class($sv); + asmf "newsv %d\t# %s\n", $sv->FLAGS & SVTYPEMASK, class($sv); stsv($ix); } @@ -137,7 +191,7 @@ sub B::GV::newix { my ($gv, $ix) = @_; my $gvname = $gv->NAME; my $name = cstring($gv->STASH->NAME . "::" . $gvname); - print "gv_fetchpv $name\n"; + asm "gv_fetchpv $name\n"; stsv($ix); } @@ -146,7 +200,7 @@ sub B::HV::newix { my $name = $hv->NAME; if ($name) { # It's a stash - printf "gv_stashpv %s\n", cstring($name); + asmf "gv_stashpv %s\n", cstring($name); stsv($ix); } else { # It's an ordinary HV. Fall back to ordinary newix method @@ -158,7 +212,7 @@ sub B::SPECIAL::newix { my ($sv, $ix) = @_; # Special case. $$sv is not the address of the SV but an # index into svspecialsv_list. - printf "ldspecsv $$sv\t# %s\n", $specialsv_name[$$sv]; + asmf "ldspecsv $$sv\t# %s\n", $specialsv_name[$$sv]; stsv($ix); } @@ -166,8 +220,8 @@ sub B::OP::newix { my ($op, $ix) = @_; my $class = class($op); my $typenum = $optype_enum{$class}; - croak "OP::newix: can't understand class $class" unless defined($typenum); - print "newop $typenum\t# $class\n"; + croak("OP::newix: can't understand class $class") unless defined($typenum); + asm "newop $typenum\t# $class\n"; stop($ix); } @@ -180,7 +234,7 @@ sub B::OP::bytecode { my $op = shift; my $next = $op->next; my $nextix; - my $sibix = $op->sibling->objix; + my $sibix = $op->sibling->objix unless $strip_syntree; my $ix = $op->objix; my $type = $op->type; @@ -189,24 +243,24 @@ sub B::OP::bytecode { } $nextix = $next->objix; - printf "# %s\n", peekop($op) if $debug_bc; + asmf "# %s\n", peekop($op) if $debug_bc; ldop($ix); - print "op_next $nextix\n"; - print "op_sibling $sibix\n" unless $strip_syntree; - printf "op_type %s\t# %d\n", "pp_" . $op->name, $type; - printf("op_seq %d\n", $op->seq) unless $omit_seq; + asm "op_next $nextix\n"; + asm "op_sibling $sibix\n" unless $strip_syntree; + asmf "op_type %s\t# %d\n", "pp_" . $op->name, $type; + asmf("op_seq %d\n", $op->seq) unless $omit_seq; if ($type || !$compress_nullops) { - printf "op_targ %d\nop_flags 0x%x\nop_private 0x%x\n", + asmf "op_targ %d\nop_flags 0x%x\nop_private 0x%x\n", $op->targ, $op->flags, $op->private; } } sub B::UNOP::bytecode { my $op = shift; - my $firstix = $op->first->objix; + my $firstix = $op->first->objix unless $strip_syntree; $op->B::OP::bytecode; if (($op->type || !$compress_nullops) && !$strip_syntree) { - print "op_first $firstix\n"; + asm "op_first $firstix\n"; } } @@ -214,7 +268,7 @@ sub B::LOGOP::bytecode { my $op = shift; my $otherix = $op->other->objix; $op->B::UNOP::bytecode; - print "op_other $otherix\n"; + asm "op_other $otherix\n"; } sub B::SVOP::bytecode { @@ -222,7 +276,7 @@ sub B::SVOP::bytecode { my $sv = $op->sv; my $svix = $sv->objix; $op->B::OP::bytecode; - print "op_sv $svix\n"; + asm "op_sv $svix\n"; $sv->bytecode; } @@ -230,7 +284,7 @@ sub B::PADOP::bytecode { my $op = shift; my $padix = $op->padix; $op->B::OP::bytecode; - print "op_padix $padix\n"; + asm "op_padix $padix\n"; } sub B::PVOP::bytecode { @@ -243,27 +297,18 @@ sub B::PVOP::bytecode { # if ($op->name eq "trans") { my @shorts = unpack("s256", $pv); # assembler handles endianness - print "op_pv_tr ", join(",", @shorts), "\n"; + asm "op_pv_tr ", join(",", @shorts), "\n"; } else { - printf "newpv %s\nop_pv\n", pvstring($pv); + asmf "newpv %s\nop_pv\n", pvstring($pv); } } sub B::BINOP::bytecode { my $op = shift; - my $lastix = $op->last->objix; + my $lastix = $op->last->objix unless $strip_syntree; $op->B::UNOP::bytecode; if (($op->type || !$compress_nullops) && !$strip_syntree) { - print "op_last $lastix\n"; - } -} - -sub B::LISTOP::bytecode { - my $op = shift; - my $children = $op->children; - $op->B::BINOP::bytecode; - if (($op->type || !$compress_nullops) && !$strip_syntree) { - print "op_children $children\n"; + asm "op_last $lastix\n"; } } @@ -273,28 +318,29 @@ sub B::LOOP::bytecode { my $nextopix = $op->nextop->objix; my $lastopix = $op->lastop->objix; $op->B::LISTOP::bytecode; - print "op_redoop $redoopix\nop_nextop $nextopix\nop_lastop $lastopix\n"; + asm "op_redoop $redoopix\nop_nextop $nextopix\nop_lastop $lastopix\n"; } sub B::COP::bytecode { my $op = shift; - my $stashpv = $op->stashpv; my $file = $op->file; my $line = $op->line; + if ($debug_bc) { # do this early to aid debugging + asmf "# line %s:%d\n", $file, $line; + } + my $stashpv = $op->stashpv; my $warnings = $op->warnings; my $warningsix = $warnings->objix; - if ($debug_bc) { - printf "# line %s:%d\n", $file, $line; - } + my $labelix = pvix($op->label); + my $stashix = pvix($stashpv); + my $fileix = pvix($file); + $warnings->bytecode; $op->B::OP::bytecode; - printf <<"EOT", pvstring($op->label), pvstring($stashpv), $op->cop_seq, pvstring($file), $op->arybase; -newpv %s -cop_label -newpv %s -cop_stashpv + asmf <<"EOT", $labelix, $stashix, $op->cop_seq, $fileix, $op->arybase; +cop_label %d +cop_stashpv %d cop_seq %d -newpv %s -cop_file +cop_file %d cop_arybase %d cop_line $line cop_warnings $warningsix @@ -322,13 +368,13 @@ sub B::PMOP::bytecode { } $op->B::LISTOP::bytecode; if ($opname eq "pushre") { - printf "op_pmreplrootgv $replrootix\n"; + asmf "op_pmreplrootgv $replrootix\n"; } else { - print "op_pmreplroot $replrootix\nop_pmreplstart $replstartix\n"; + asm "op_pmreplroot $replrootix\nop_pmreplstart $replstartix\n"; } my $re = pvstring($op->precomp); # op_pmnext omitted since a perl bug means it's sometime corrupt - printf <<"EOT", $op->pmflags, $op->pmpermflags; + asmf <<"EOT", $op->pmflags, $op->pmpermflags; op_pmflags 0x%x op_pmpermflags 0x%x newpv $re @@ -343,7 +389,7 @@ sub B::SV::bytecode { my $refcnt = $sv->REFCNT; my $flags = sprintf("0x%x", $sv->FLAGS); ldsv($ix); - print "sv_refcnt $refcnt\nsv_flags $flags\n"; + asm "sv_refcnt $refcnt\nsv_flags $flags\n"; mark_saved($sv); } @@ -351,7 +397,7 @@ sub B::PV::bytecode { my $sv = shift; return if saved($sv); $sv->B::SV::bytecode; - printf("newpv %s\nxpv\n", pvstring($sv->PV)) if $sv->FLAGS & POK; + asmf("newpv %s\nxpv\n", pvstring($sv->PV)) if $sv->FLAGS & POK; } sub B::IV::bytecode { @@ -359,14 +405,14 @@ sub B::IV::bytecode { return if saved($sv); my $iv = $sv->IVX; $sv->B::SV::bytecode; - printf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32"; + asmf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32" if $sv->FLAGS & IOK; # could be PVNV } sub B::NV::bytecode { my $sv = shift; return if saved($sv); $sv->B::SV::bytecode; - printf "xnv %s\n", $sv->NVX; + asmf "xnv %s\n", nv($sv->NVX); } sub B::RV::bytecode { @@ -376,7 +422,7 @@ sub B::RV::bytecode { my $rvix = $rv->objix; $rv->bytecode; $sv->B::SV::bytecode; - print "xrv $rvix\n"; + asm "xrv $rvix\n"; } sub B::PVIV::bytecode { @@ -384,7 +430,7 @@ sub B::PVIV::bytecode { return if saved($sv); my $iv = $sv->IVX; $sv->B::PV::bytecode; - printf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32"; + asmf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32"; } sub B::PVNV::bytecode { @@ -404,12 +450,12 @@ sub B::PVNV::bytecode { } else { my $pv = $sv->PV; $sv->B::IV::bytecode; - printf "xnv %s\n", $sv->NVX; + asmf "xnv %s\n", nv($sv->NVX); if ($flag == 1) { $pv .= "\0" . $sv->TABLE; - printf "newpv %s\npv_cur %d\nxpv\n", pvstring($pv),length($pv)-257; + asmf "newpv %s\npv_cur %d\nxpv\n", pvstring($pv),length($pv)-257; } else { - printf("newpv %s\nxpv\n", pvstring($pv)) if $sv->FLAGS & POK; + asmf("newpv %s\nxpv\n", pvstring($pv)) if $sv->FLAGS & POK; } } } @@ -431,9 +477,9 @@ sub B::PVMG::bytecode { # @mgobjix = map($_->OBJ->objix, @mgchain); $sv->B::PVNV::bytecode($flag); - print "xmg_stash $stashix\n"; + asm "xmg_stash $stashix\n"; foreach $mg (@mgchain) { - printf "sv_magic %s\nmg_obj %d\nnewpv %s\nmg_pv\n", + asmf "sv_magic %s\nmg_obj %d\nnewpv %s\nmg_pv\n", cstring($mg->TYPE), shift(@mgobjix), pvstring($mg->PTR); } } @@ -442,7 +488,7 @@ sub B::PVLV::bytecode { my $sv = shift; return if saved($sv); $sv->B::PVMG::bytecode; - printf <<'EOT', $sv->TARGOFF, $sv->TARGLEN, cstring($sv->TYPE); + asmf <<'EOT', $sv->TARGOFF, $sv->TARGLEN, cstring($sv->TYPE); xlv_targoff %d xlv_targlen %d xlv_type %s @@ -454,46 +500,63 @@ sub B::BM::bytecode { return if saved($sv); # See PVNV::bytecode for an explanation of what the argument does $sv->B::PVMG::bytecode(1); - printf "xbm_useful %d\nxbm_previous %d\nxbm_rare %d\n", + asmf "xbm_useful %d\nxbm_previous %d\nxbm_rare %d\n", $sv->USEFUL, $sv->PREVIOUS, $sv->RARE; } +sub empty_gv { # is a GV empty except for imported stuff? + my $gv = shift; + + return 0 if ($gv->SV->FLAGS & SVTYPEMASK); # sv not SVt_NULL + my @subfield_names = qw(AV HV CV FORM IO); + @subfield_names = grep {; + no strict 'refs'; + !($gv->GvFLAGS & ${\"GVf_IMPORTED_$_"}->()) && ${$gv->$_()}; + } @subfield_names; + return scalar @subfield_names; +} + sub B::GV::bytecode { my $gv = shift; return if saved($gv); + return unless grep { $_ eq $gv->STASH->NAME; } @packages; + return if $gv->NAME =~ m/^\(/; # ignore overloads - they'll be rebuilt my $ix = $gv->objix; mark_saved($gv); ldsv($ix); - printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS; + asmf <<"EOT", $gv->FLAGS, $gv->GvFLAGS; sv_flags 0x%x xgv_flags 0x%x EOT my $refcnt = $gv->REFCNT; - printf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1; + asmf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1; return if $gv->is_empty; - printf <<"EOT", $gv->LINE, pvstring($gv->FILE); + asmf <<"EOT", $gv->LINE, pvix($gv->FILE); gp_line %d -newpv %s -gp_file +gp_file %d EOT my $gvname = $gv->NAME; my $name = cstring($gv->STASH->NAME . "::" . $gvname); my $egv = $gv->EGV; my $egvix = $egv->objix; my $gvrefcnt = $gv->GvREFCNT; - printf("gp_refcnt_add %d\n", $gvrefcnt - 1) if $gvrefcnt > 1; + asmf("gp_refcnt_add %d\n", $gvrefcnt - 1) if $gvrefcnt > 1; if ($gvrefcnt > 1 && $ix != $egvix) { - print "gp_share $egvix\n"; + asm "gp_share $egvix\n"; } else { if ($gvname !~ /^([^A-Za-z]|STDIN|STDOUT|STDERR|ARGV|SIG|ENV)$/) { my $i; my @subfield_names = qw(SV AV HV CV FORM IO); + @subfield_names = grep {; + no strict 'refs'; + !($gv->GvFLAGS & ${\"GVf_IMPORTED_$_"}->()); + } @subfield_names; my @subfields = map($gv->$_(), @subfield_names); my @ixes = map($_->objix, @subfields); # Reset sv register for $gv ldsv($ix); for ($i = 0; $i < @ixes; $i++) { - printf "gp_%s %d\n", lc($subfield_names[$i]), $ixes[$i]; + asmf "gp_%s %d\n", lc($subfield_names[$i]), $ixes[$i]; } # Now save all the subfields my $sv; @@ -523,10 +586,10 @@ sub B::HV::bytecode { } ldsv($ix); for ($i = 0; $i < @contents; $i += 2) { - printf("newpv %s\nhv_store %d\n", + asmf("newpv %s\nhv_store %d\n", pvstring($contents[$i]), $ixes[$i / 2]); } - printf "sv_refcnt %d\nsv_flags 0x%x\n", $hv->REFCNT, $hv->FLAGS; + asmf "sv_refcnt %d\nsv_flags 0x%x\n", $hv->REFCNT, $hv->FLAGS; } } @@ -551,22 +614,26 @@ sub B::AV::bytecode { # create an AV with NEWSV and SvUPGRADE rather than doing newAV # which is what sets AvMAX and AvFILL. ldsv($ix); - printf "xav_flags 0x%x\nxav_max -1\nxav_fill -1\n", $av->AvFLAGS; + asmf "sv_flags 0x%x\n", $av->FLAGS & ~SVf_READONLY; # SvREADONLY_off($av) in case PADCONST + asmf "xav_flags 0x%x\nxav_max -1\nxav_fill -1\n", $av->AvFLAGS; if ($fill > -1) { my $elix; foreach $elix (@ixes) { - print "av_push $elix\n"; + asm "av_push $elix\n"; } } else { if ($max > -1) { - print "av_extend $max\n"; + asm "av_extend $max\n"; } } + asmf "sv_flags 0x%x\n", $av->FLAGS; # restore flags from above } sub B::CV::bytecode { my $cv = shift; return if saved($cv); + return if ${$cv->GV} && ($cv->GV->GvFLAGS & GVf_IMPORTED_CV); + my $fileix = pvix($cv->FILE); my $ix = $cv->objix; $cv->B::PVMG::bytecode; my $i; @@ -581,10 +648,10 @@ sub B::CV::bytecode { # Reset sv register for $cv (since above ->objix calls stomped on it) ldsv($ix); for ($i = 0; $i < @ixes; $i++) { - printf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i]; + asmf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i]; } - printf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->CvFLAGS; - printf "newpv %s\nxcv_file\n", pvstring($cv->FILE); + asmf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->CvFLAGS; + asmf "xcv_file %d\n", $fileix; # Now save all the subfields (except for CvROOT which was handled # above) and CvSTART (now the initial element of @subfields). shift @subfields; # bye-bye CvSTART @@ -607,17 +674,17 @@ sub B::IO::bytecode { $io->B::PVMG::bytecode; ldsv($ix); - print "xio_top_gv $top_gvix\n"; - print "xio_fmt_gv $fmt_gvix\n"; - print "xio_bottom_gv $bottom_gvix\n"; + asm "xio_top_gv $top_gvix\n"; + asm "xio_fmt_gv $fmt_gvix\n"; + asm "xio_bottom_gv $bottom_gvix\n"; my $field; foreach $field (qw(TOP_NAME FMT_NAME BOTTOM_NAME)) { - printf "newpv %s\nxio_%s\n", pvstring($io->$field()), lc($field); + asmf "newpv %s\nxio_%s\n", pvstring($io->$field()), lc($field); } foreach $field (qw(LINES PAGE PAGE_LEN LINES_LEFT SUBPROCESS)) { - printf "xio_%s %d\n", lc($field), $io->$field(); + asmf "xio_%s %d\n", lc($field), $io->$field(); } - printf "xio_type %s\nxio_flags 0x%x\n", cstring($io->IoTYPE), $io->IoFLAGS; + asmf "xio_type %s\nxio_flags 0x%x\n", cstring($io->IoTYPE), $io->IoFLAGS; $top_gv->bytecode; $fmt_gv->bytecode; $bottom_gv->bytecode; @@ -628,8 +695,7 @@ sub B::SPECIAL::bytecode { } sub bytecompile_object { - my $sv; - foreach $sv (@_) { + for my $sv (@_) { svref_2object($sv)->bytecode; } } @@ -637,7 +703,7 @@ sub bytecompile_object { sub B::GV::bytecodecv { my $gv = shift; my $cv = $gv->CV; - if ($$cv && !saved($cv)) { + if ($$cv && !saved($cv) && !($gv->FLAGS & GVf_IMPORTED_CV)) { if ($debug_cv) { warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n", $gv->STASH->NAME, $gv->NAME, $$cv, $$gv); @@ -646,43 +712,66 @@ sub B::GV::bytecodecv { } } +sub save_call_queues { + if (begin_av()->isa("B::AV")) { # this is just to save 'use Foo;' calls + for my $cv (begin_av()->ARRAY) { + next unless grep { $_ eq $cv->STASH->NAME; } @packages; + my $op = $cv->START; +OPLOOP: + while ($$op) { + if ($op->name eq 'require') { # save any BEGIN that does a require + $cv->bytecode; + asmf "push_begin %d\n", $cv->objix; + last OPLOOP; + } + $op = $op->next; + } + } + } + if (init_av()->isa("B::AV")) { + for my $cv (init_av()->ARRAY) { + next unless grep { $_ eq $cv->STASH->NAME; } @packages; + $cv->bytecode; + asmf "push_init %d\n", $cv->objix; + } + } + if (end_av()->isa("B::AV")) { + for my $cv (end_av()->ARRAY) { + next unless grep { $_ eq $cv->STASH->NAME; } @packages; + $cv->bytecode; + asmf "push_end %d\n", $cv->objix; + } + } +} + +sub symwalk { + no strict 'refs'; + my $ok = 1 if grep { (my $name = $_[0]) =~ s/::$//; $_ eq $name;} @packages; + if (grep { /^$_[0]/; } @packages) { + walksymtable(\%{"$_[0]"}, "bytecodecv", \&symwalk, $_[0]); + } + warn "considering $_[0] ... " . ($ok ? "accepted\n" : "rejected\n") + if $debug_bc; + $ok; +} + sub bytecompile_main { my $curpad = (comppadlist->ARRAY)[1]; my $curpadix = $curpad->objix; $curpad->bytecode; - walkoptree(main_root, "bytecode"); + save_call_queues(); + walkoptree(main_root, "bytecode") unless ref(main_root) eq "B::NULL"; warn "done main program, now walking symbol table\n" if $debug_bc; - my ($pack, %exclude); - foreach $pack (qw(B O AutoLoader DynaLoader XSLoader Config DB VMS strict vars - FileHandle Exporter Carp UNIVERSAL IO Fcntl Symbol - SelectSaver blib Cwd)) - { - $exclude{$pack."::"} = 1; + if (@packages) { + no strict qw(refs); + walksymtable(\%{"main::"}, "bytecodecv", \&symwalk); + } else { + die "No packages requested for compilation!\n"; } - no strict qw(vars refs); - walksymtable(\%{"main::"}, "bytecodecv", sub { - warn "considering $_[0]\n" if $debug_bc; - return !defined($exclude{$_[0]}); - }); - if (!$module_only) { - printf "main_root %d\n", main_root->objix; - printf "main_start %d\n", main_start->objix; - printf "curpad $curpadix\n"; - # XXX Do min_intro_pending and max_intro_pending matter? - } -} - -sub prepare_assemble { - my $newfh = IO::File->new_tmpfile; - select($newfh); - binmode $newfh; - return $newfh; -} - -sub do_assemble { - my $fh = shift; - seek($fh, 0, 0); # rewind the temporary file - assemble_fh($fh, sub { print OUT @_ }); + asmf "main_root %d\n", main_root->objix; + asmf "main_start %d\n", main_start->objix; + asmf "curpad $curpadix\n"; + # XXX Do min_intro_pending and max_intro_pending matter? } sub compile { @@ -690,7 +779,7 @@ sub compile { my ($option, $opt, $arg); open(OUT, ">&STDOUT"); binmode OUT; - select(OUT); + select OUT; OPTION: while ($option = shift @options) { if ($option =~ /^-(.)(.*)/) { @@ -727,8 +816,6 @@ sub compile { } } elsif ($opt eq "v") { $verbose = 1; - } elsif ($opt eq "m") { - $module_only = 1; } elsif ($opt eq "S") { $no_assemble = 1; } elsif ($opt eq "f") { @@ -747,9 +834,6 @@ sub compile { foreach $ref (values %optimise) { $$ref = 0; } - if ($arg >= 6) { - $strip_syntree = 1; - } if ($arg >= 2) { $bypass_nullops = 1; } @@ -757,28 +841,30 @@ sub compile { $compress_nullops = 1; $omit_seq = 1; } + } elsif ($opt eq "u") { + $arg ||= shift @options; + push @packages, $arg; + } else { + warn qq(ignoring unknown option "$opt$arg"\n); } } + if (! @packages) { + warn "No package specified for compilation, assuming main::\n"; + @packages = qw(main); + } if (@options) { - return sub { - my $objname; - my $newfh; - $newfh = prepare_assemble() unless $no_assemble; - foreach $objname (@options) { - eval "bytecompile_object(\\$objname)"; - } - do_assemble($newfh) unless $no_assemble; - } + die "Extraneous options left on B::Bytecode commandline: @options\n"; } else { - return sub { - my $newfh; - $newfh = prepare_assemble() unless $no_assemble; + return sub { + newasm(\&apr) unless $no_assemble; bytecompile_main(); - do_assemble($newfh) unless $no_assemble; - } + endasm() unless $no_assemble; + }; } } +sub apr { print @_; } + 1; __END__ @@ -848,18 +934,11 @@ which is only used by perl's internal compiler. If op->op_next ever points to a NULLOP, replaces the op_next field with the first non-NULLOP in the path of execution. -=item B<-fstrip-syntax-tree> - -Leaves out code to fill in the pointers which link the internal syntax -tree together. They're not needed at run-time but leaving them out -will make it impossible to recompile or disassemble the resulting -program. It will also stop C statements from working. - =item B<-On> Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>. B<-O1> sets B<-fcompress-nullops> B<-fomit-sequence numbers>. -B<-O6> adds B<-fstrip-syntax-tree>. +B<-O2> adds B<-fbypass-nullops>. =item B<-D> @@ -887,33 +966,33 @@ Prints each CV taken from the final symbol tree walk. Output (bytecode) assembler source rather than piping it through the assembler and outputting bytecode. -=item B<-m> - -Compile as a module rather than a standalone program. Currently this -just means that the bytecodes for initialising C, -C and C are omitted. - +=item B<-upackage> + +Stores package in the output. + =back =head1 EXAMPLES - perl -MO=Bytecode,-O6,-o,foo.plc foo.pl + perl -MO=Bytecode,-O6,-ofoo.plc,-umain foo.pl - perl -MO=Bytecode,-S foo.pl > foo.S + perl -MO=Bytecode,-S,-umain foo.pl > foo.S assemble foo.S > foo.plc Note that C lives in the C subdirectory of your perl library directory. The utility called perlcc may also be used to help make use of this compiler. - perl -MO=Bytecode,-m,-oFoo.pmc Foo.pm + perl -MO=Bytecode,-uFoo,-oFoo.pmc Foo.pm =head1 BUGS -Plenty. Current status: experimental. +Output is still huge and there are still occasional crashes during +either compilation or ByteLoading. Current status: experimental. -=head1 AUTHOR +=head1 AUTHORS Malcolm Beattie, C +Benjamin Stuhl, C =cut diff --git a/contrib/perl5/ext/B/B/C.pm b/contrib/perl5/ext/B/B/C.pm index d0c8159d9f31..4befe7988ba2 100644 --- a/contrib/perl5/ext/B/B/C.pm +++ b/contrib/perl5/ext/B/B/C.pm @@ -225,11 +225,10 @@ sub B::LISTOP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - $listopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u", + $listopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x", ${$op->next}, ${$op->sibling}, $op->targ, $op->type, $op_seq, $op->flags, - $op->private, ${$op->first}, ${$op->last}, - $op->children)); + $op->private, ${$op->first}, ${$op->last})); my $ix = $listopsect->index; $init->add(sprintf("listop_list[$ix].op_ppaddr = %s;", $op->ppaddr)); savesym($op, "(OP*)&listop_list[$ix]"); @@ -255,11 +254,11 @@ sub B::LOOP::save { #warn sprintf("LOOP: redoop %s, nextop %s, lastop %s\n", # peekop($op->redoop), peekop($op->nextop), # peekop($op->lastop)); # debug - $loopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, s\\_%x, s\\_%x, s\\_%x", + $loopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x", ${$op->next}, ${$op->sibling}, $op->targ, $op->type, $op_seq, $op->flags, $op->private, ${$op->first}, ${$op->last}, - $op->children, ${$op->redoop}, ${$op->nextop}, + ${$op->redoop}, ${$op->nextop}, ${$op->lastop})); my $ix = $loopsect->index; $init->add(sprintf("loop_list[$ix].op_ppaddr = %s;", $op->ppaddr)); @@ -351,10 +350,10 @@ sub B::PMOP::save { # pmnext handling is broken in perl itself, I think. Bad op_pmnext # fields aren't noticed in perl's runtime (unless you try reset) but we # segfault when trying to dereference it to find op->op_pmnext->op_type - $pmopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, %s, %s, 0, 0, 0x%x, 0x%x", + $pmopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %s, %s, 0, 0, 0x%x, 0x%x", ${$op->next}, ${$op->sibling}, $op->targ, $op->type, $op_seq, $op->flags, $op->private, - ${$op->first}, ${$op->last}, $op->children, + ${$op->first}, ${$op->last}, $replrootfield, $replstartfield, $op->pmflags, $op->pmpermflags,)); my $pm = sprintf("pmop_list[%d]", $pmopsect->index); @@ -1020,9 +1019,8 @@ sub output_all { print <<"EOT"; static int $init_name() { - dTHR; dTARG; - djSP; + dSP; EOT $init->output(\*STDOUT, "\t%s\n"); print "\treturn 0;\n}\n"; @@ -1050,15 +1048,15 @@ typedef struct { STRLEN xpv_cur; /* length of xp_pv as a C string */ STRLEN xpv_len; /* allocated size */ IV xof_off; /* integer value */ - double xnv_nv; /* numeric value, if any */ + NV xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* magic for scalar array */ HV* xmg_stash; /* class package */ HV * xcv_stash; OP * xcv_start; OP * xcv_root; - void (*xcv_xsub) (CV*); - void * xcv_xsubany; + void (*xcv_xsub) (pTHXo_ CV*); + ANY xcv_xsubany; GV * xcv_gv; char * xcv_file; long xcv_depth; /* >= 2 indicates recursive call */ @@ -1174,7 +1172,7 @@ xs_init(pTHX) { char *file = __FILE__; dTARG; - djSP; + dSP; EOT print "\n#ifdef USE_DYNAMIC_LOADING"; print qq/\n\tnewXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);/; @@ -1210,7 +1208,7 @@ dl_init(pTHX) { char *file = __FILE__; dTARG; - djSP; + dSP; EOT print("/* Dynamicboot strapping code*/\n\tSAVETMPS;\n"); print("\ttarg=sv_newmortal();\n"); @@ -1338,7 +1336,7 @@ sub should_save # Now see if current package looks like an OO class this is probably too strong. foreach my $m (qw(new DESTROY TIESCALAR TIEARRAY TIEHASH TIEHANDLE)) { - if ($package->can($m)) + if (UNIVERSAL::can($package, $m)) { warn "$package has method $m: saving package\n";#debug return mark_package($package); @@ -1368,7 +1366,7 @@ sub walkpackages if ($sym =~ /::$/) { $sym = $prefix . $sym; - if ($sym ne "main::" && &$recurse($sym)) + if ($sym ne "main::" && $sym ne "::" && &$recurse($sym)) { walkpackages(\%glob, $recurse, $sym); } diff --git a/contrib/perl5/ext/B/B/CC.pm b/contrib/perl5/ext/B/B/CC.pm index c5ca2a3df5bb..51922eeb2b21 100644 --- a/contrib/perl5/ext/B/B/CC.pm +++ b/contrib/perl5/ext/B/B/CC.pm @@ -151,7 +151,7 @@ sub init_pp { $ppname = shift; $runtime_list_ref = []; $declare_ref = {}; - runtime("djSP;"); + runtime("dSP;"); declare("I32", "oldsave"); declare("SV", "**svp"); map { declare("SV", "*$_") } qw(sv src dst left right); diff --git a/contrib/perl5/ext/B/B/Debug.pm b/contrib/perl5/ext/B/B/Debug.pm index ae7a9733bcdd..049195b42369 100644 --- a/contrib/perl5/ext/B/B/Debug.pm +++ b/contrib/perl5/ext/B/B/Debug.pm @@ -33,6 +33,16 @@ sub B::BINOP::debug { printf "\top_last\t\t0x%x\n", ${$op->last}; } +sub B::LOOP::debug { + my ($op) = @_; + $op->B::BINOP::debug(); + printf <<'EOT', ${$op->redoop}, ${$op->nextop}, ${$op->lastop}; + op_redoop 0x%x + op_nextop 0x%x + op_lastop 0x%x +EOT +} + sub B::LOGOP::debug { my ($op) = @_; $op->B::UNOP::debug(); @@ -53,7 +63,6 @@ sub B::PMOP::debug { printf "\top_pmnext\t0x%x\n", ${$op->pmnext}; printf "\top_pmregexp->precomp\t%s\n", cstring($op->precomp); printf "\top_pmflags\t0x%x\n", $op->pmflags; - $op->pmshort->debug; $op->pmreplroot->debug; } @@ -209,14 +218,14 @@ EOT sub B::GV::debug { my ($gv) = @_; if ($done_gv{$$gv}++) { - printf "GV %s::%s\n", $gv->STASH->NAME, $gv->NAME; + printf "GV %s::%s\n", $gv->STASH->NAME, $gv->SAFENAME; return; } my ($sv) = $gv->SV; my ($av) = $gv->AV; my ($cv) = $gv->CV; $gv->B::SV::debug; - printf <<'EOT', $gv->NAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILE, $gv->GvFLAGS; + printf <<'EOT', $gv->SAFENAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILE, $gv->GvFLAGS; NAME %s STASH %s (0x%x) SV 0x%x @@ -244,7 +253,7 @@ sub B::SPECIAL::debug { sub compile { my $order = shift; B::clearsym(); - if ($order eq "exec") { + if ($order && $order eq "exec") { return sub { walkoptree_exec(main_start, "debug") } } else { return sub { walkoptree(main_root, "debug") } diff --git a/contrib/perl5/ext/B/B/Deparse.pm b/contrib/perl5/ext/B/B/Deparse.pm index cd53c112d8c2..ead02e14a84f 100644 --- a/contrib/perl5/ext/B/B/Deparse.pm +++ b/contrib/perl5/ext/B/B/Deparse.pm @@ -1,5 +1,5 @@ # B::Deparse.pm -# Copyright (c) 1998, 1999 Stephen McCamant. All rights reserved. +# Copyright (c) 1998, 1999, 2000 Stephen McCamant. All rights reserved. # This module is free software; you can redistribute and/or modify # it under the same terms as Perl itself. @@ -8,16 +8,16 @@ package B::Deparse; use Carp 'cluck', 'croak'; -use Config; use B qw(class main_root main_start main_cv svref_2object opnumber OPf_WANT OPf_WANT_VOID OPf_WANT_SCALAR OPf_WANT_LIST OPf_KIDS OPf_REF OPf_STACKED OPf_SPECIAL OPpLVAL_INTRO OPpENTERSUB_AMPER OPpSLICE OPpCONST_BARE OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY 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_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED); -$VERSION = 0.59; +$VERSION = 0.60; use strict; # Changes between 0.50 and 0.51: @@ -83,6 +83,12 @@ use strict; # - added support for Chip's OP_METHOD_NAMED # - added support for Ilya's OPpTARGET_MY optimization # - elided arrows before `()' subscripts when possible +# Changes between 0.59 and 0.60 +# - support for method attribues was added +# - some warnings fixed +# - separate recognition of constant subs +# - rewrote continue block handling, now recoginizing for loops +# - added more control of expanding control structures # Todo: # - finish tr/// changes @@ -93,8 +99,8 @@ use strict; # - left/right context # - recognize `use utf8', `use integer', etc # - treat top-level block specially for incremental output -# - interpret in high bit chars in string as utf8 \x{...} (when?) -# - copy comments (look at real text with $^P?) +# - interpret high bit chars in string as utf8 \x{...} (when?) +# - copy comments (look at real text with $^P?) # - avoid semis in one-statement blocks # - associativity of &&=, ||=, ?: # - ',' => '=>' (auto-unquote?) @@ -108,7 +114,6 @@ use strict; # - version using op_next instead of op_first/sibling? # - avoid string copies (pass arrays, one big join?) # - auto-apply `-u'? -# - while{} with one-statement continue => for(; XXX; XXX) {}? # - -uPackage:: descend recursively? # - here-docs? # - ? @@ -252,17 +257,17 @@ sub walk_sub { walk_tree($op, sub { my $op = shift; if ($op->name eq "gv") { - my $gv = $self->maybe_padgv($op); + my $gv = $self->gv_or_padgv($op); if ($op->next->name eq "entersub") { - next if $self->{'subs_done'}{$$gv}++; - next if class($gv->CV) eq "SPECIAL"; + return if $self->{'subs_done'}{$$gv}++; + return if class($gv->CV) eq "SPECIAL"; $self->todo($gv, $gv->CV, 0); $self->walk_sub($gv->CV); } elsif ($op->next->name eq "enterwrite" or ($op->next->name eq "rv2gv" and $op->next->next->name eq "enterwrite")) { - next if $self->{'forms_done'}{$$gv}++; - next if class($gv->FORM) eq "SPECIAL"; + return if $self->{'forms_done'}{$$gv}++; + return if class($gv->FORM) eq "SPECIAL"; $self->todo($gv, $gv->FORM, 1); $self->walk_sub($gv->FORM); } @@ -345,6 +350,10 @@ sub new { $self->{'cuddle'} = "\n"; $self->{'indent_size'} = 4; $self->{'use_tabs'} = 0; + $self->{'expand'} = 0; + $self->{'unquote'} = 0; + $self->{'linenums'} = 0; + $self->{'parens'} = 0; $self->{'ex_const'} = "'???'"; while (my $arg = shift @_) { if (substr($arg, 0, 2) eq "-u") { @@ -357,6 +366,8 @@ sub new { $self->{'unquote'} = 1; } elsif (substr($arg, 0, 2) eq "-s") { $self->style_opts(substr $arg, 2); + } elsif ($arg =~ /^-x(\d)$/) { + $self->{'expand'} = $1; } } return $self; @@ -378,7 +389,7 @@ sub compile { while (scalar(@{$self->{'subs_todo'}})) { push @text, $self->next_todo; } - print indent(join("", @text)), "\n" if @text; + print $self->indent(join("", @text)), "\n" if @text; } } @@ -393,6 +404,7 @@ sub deparse { my $self = shift; my($op, $cx) = @_; # cluck if class($op) eq "NULL"; +# cluck unless $op; # return $self->$ {\("pp_" . $op->name)}($op, $cx); my $meth = "pp_" . $op->name; return $self->$meth($op, $cx); @@ -433,6 +445,13 @@ sub deparse_sub { if ($cv->FLAGS & SVf_POK) { $proto = "(". $cv->PV . ") "; } + if ($cv->CvFLAGS & (CVf_METHOD|CVf_LOCKED|CVf_LVALUE)) { + $proto .= ": "; + $proto .= "lvalue " if $cv->CvFLAGS & CVf_LVALUE; + $proto .= "locked " if $cv->CvFLAGS & CVf_LOCKED; + $proto .= "method " if $cv->CvFLAGS & CVf_METHOD; + } + local($self->{'curcv'}) = $cv; local($self->{'curstash'}) = $self->{'curstash'}; if (not null $cv->ROOT) { @@ -553,7 +572,11 @@ sub maybe_local { my $self = shift; my($op, $cx, $text) = @_; if ($op->private & OPpLVAL_INTRO and not $self->{'avoid_local'}{$$op}) { - return $self->maybe_parens_func("local", $text, $cx, 16); + if (want_scalar($op)) { + return "local $text"; + } else { + return $self->maybe_parens_func("local", $text, $cx, 16); + } } else { return $text; } @@ -581,7 +604,11 @@ sub maybe_my { my $self = shift; my($op, $cx, $text) = @_; if ($op->private & OPpLVAL_INTRO and not $self->{'avoid_local'}{$$op}) { - return $self->maybe_parens_func("my", $text, $cx, 16); + if (want_scalar($op)) { + return "my $text"; + } else { + return $self->maybe_parens_func("my", $text, $cx, 16); + } } else { return $text; } @@ -672,70 +699,69 @@ sub pp_entertry { # see also leavetry return "XXX"; } -# leave and scope/lineseq should probably share code -sub pp_leave { +sub lineseq { my $self = shift; - my($op, $cx) = @_; - my ($kid, $expr); - my @exprs; - local($self->{'curstash'}) = $self->{'curstash'}; - $kid = $op->first->sibling; # skip enter - if (is_miniwhile($kid)) { - my $top = $kid->first; - my $name = $top->name; - if ($name eq "and") { - $name = "while"; - } elsif ($name eq "or") { - $name = "until"; - } else { # no conditional -> while 1 or until 0 - return $self->deparse($top->first, 1) . " while 1"; + my(@ops) = @_; + my($expr, @exprs); + for (my $i = 0; $i < @ops; $i++) { + $expr = ""; + if (is_state $ops[$i]) { + $expr = $self->deparse($ops[$i], 0); + $i++; + last if $i > $#ops; } - my $cond = $top->first; - my $body = $cond->sibling->first; # skip lineseq - $cond = $self->deparse($cond, 1); - $body = $self->deparse($body, 1); - return "$body $name $cond"; + 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) + { + push @exprs, $expr . $self->for_loop($ops[$i], 0); + $i++; + next; + } + $expr .= $self->deparse($ops[$i], 0); + push @exprs, $expr if length $expr; + } + return join(";\n", @exprs); +} + +sub scopeop { + my($real_block, $self, $op, $cx) = @_; + my $kid; + my @kids; + local($self->{'curstash'}) = $self->{'curstash'} if $real_block; + if ($real_block) { + $kid = $op->first->sibling; # skip enter + if (is_miniwhile($kid)) { + my $top = $kid->first; + my $name = $top->name; + if ($name eq "and") { + $name = "while"; + } elsif ($name eq "or") { + $name = "until"; + } else { # no conditional -> while 1 or until 0 + return $self->deparse($top->first, 1) . " while 1"; + } + my $cond = $top->first; + my $body = $cond->sibling->first; # skip lineseq + $cond = $self->deparse($cond, 1); + $body = $self->deparse($body, 1); + return "$body $name $cond"; + } + } else { + $kid = $op->first; } for (; !null($kid); $kid = $kid->sibling) { - $expr = ""; - if (is_state $kid) { - $expr = $self->deparse($kid, 0); - $kid = $kid->sibling; - last if null $kid; - } - $expr .= $self->deparse($kid, 0); - push @exprs, $expr if length $expr; - } - if ($cx > 0) { # inside an expression - return "do { " . join(";\n", @exprs) . " }"; - } else { - return join(";\n", @exprs) . ";"; - } -} - -sub pp_scope { - my $self = shift; - my($op, $cx) = @_; - my ($kid, $expr); - my @exprs; - for ($kid = $op->first; !null($kid); $kid = $kid->sibling) { - $expr = ""; - if (is_state $kid) { - $expr = $self->deparse($kid, 0); - $kid = $kid->sibling; - last if null $kid; - } - $expr .= $self->deparse($kid, 0); - push @exprs, $expr if length $expr; + push @kids, $kid; } if ($cx > 0) { # inside an expression, (a do {} while for lineseq) - return "do { " . join(";\n", @exprs) . " }"; + return "do { " . $self->lineseq(@kids) . " }"; } else { - return join(";\n", @exprs) . ";"; + return $self->lineseq(@kids) . ";"; } } -sub pp_lineseq { pp_scope(@_) } +sub pp_scope { scopeop(0, @_); } +sub pp_lineseq { scopeop(0, @_); } +sub pp_leave { scopeop(1, @_); } # The BEGIN {} is used here because otherwise this code isn't executed # when you run B::Deparse on itself. @@ -747,7 +773,7 @@ sub gv_name { my $self = shift; my $gv = shift; my $stash = $gv->STASH->NAME; - my $name = $gv->NAME; + my $name = $gv->SAFENAME; if ($stash eq $self->{'curstash'} or $globalnames{$name} or $name =~ /^[^A-Za-z_]/) { @@ -755,8 +781,8 @@ sub gv_name { } else { $stash = $stash . "::"; } - if ($name =~ /^([\cA-\cZ])$/) { - $name = "^" . chr(64 + ord($1)); + if ($name =~ /^\^../) { + $name = "{$name}"; # ${^WARNING_BITS} etc } return $stash . $name; } @@ -840,7 +866,7 @@ sub pp_i_preinc { pfixop(@_, "++", 23) } sub pp_i_predec { pfixop(@_, "--", 23) } sub pp_i_postinc { maybe_targmy(@_, \&pfixop, "++", 23, POSTFIX) } sub pp_i_postdec { maybe_targmy(@_, \&pfixop, "--", 23, POSTFIX) } -sub pp_complement { maybe_targmy(@_. \&pfixop, "~", 21) } +sub pp_complement { maybe_targmy(@_, \&pfixop, "~", 21) } sub pp_negate { maybe_targmy(@_, \&real_negate) } sub real_negate { @@ -917,7 +943,6 @@ sub pp_prototype { unop(@_, "prototype") } sub pp_close { unop(@_, "close") } sub pp_fileno { unop(@_, "fileno") } sub pp_umask { unop(@_, "umask") } -sub pp_binmode { unop(@_, "binmode") } sub pp_untie { unop(@_, "untie") } sub pp_tied { unop(@_, "tied") } sub pp_dbmclose { unop(@_, "dbmclose") } @@ -1373,11 +1398,14 @@ sub logop { my ($op, $cx, $lowop, $lowprec, $highop, $highprec, $blockname) = @_; my $left = $op->first; my $right = $op->first->sibling; - if ($cx == 0 and is_scope($right) and $blockname) { # if ($a) {$b} + if ($cx == 0 and is_scope($right) and $blockname + and $self->{'expand'} < 7) + { # if ($a) {$b} $left = $self->deparse($left, 1); $right = $self->deparse($right, 0); return "$blockname ($left) {\n\t$right\n\b}\cK"; - } elsif ($cx == 0 and $blockname and not $self->{'parens'}) { # $b if $a + } elsif ($cx == 0 and $blockname and not $self->{'parens'} + and $self->{'expand'} < 7) { # $b if $a $right = $self->deparse($right, 1); $left = $self->deparse($left, 1); return "$right $blockname $left"; @@ -1457,6 +1485,7 @@ sub pp_return { listop(@_, "return") } sub pp_open { listop(@_, "open") } sub pp_pipe_op { listop(@_, "pipe") } sub pp_tie { listop(@_, "tie") } +sub pp_binmode { listop(@_, "binmode") } sub pp_dbmopen { listop(@_, "dbmopen") } sub pp_sselect { listop(@_, "select") } sub pp_select { listop(@_, "select") } @@ -1653,6 +1682,13 @@ sub pp_list { } } +sub is_ifelse_cont { + my $op = shift; + return ($op->name eq "null" and class($op) eq "UNOP" + and $op->first->name =~ /^(and|cond_expr)$/ + and is_scope($op->first->first->sibling)); +} + sub pp_cond_expr { my $self = shift; my($op, $cx) = @_; @@ -1660,52 +1696,55 @@ sub pp_cond_expr { my $true = $cond->sibling; my $false = $true->sibling; my $cuddle = $self->{'cuddle'}; - unless ($cx == 0 and is_scope($true) and is_scope($false)) { + unless ($cx == 0 and (is_scope($true) and $true->name ne "null") and + (is_scope($false) || is_ifelse_cont($false)) + and $self->{'expand'} < 7) { $cond = $self->deparse($cond, 8); $true = $self->deparse($true, 8); $false = $self->deparse($false, 8); return $self->maybe_parens("$cond ? $true : $false", $cx, 8); - } + } + $cond = $self->deparse($cond, 1); $true = $self->deparse($true, 0); - if ($false->name eq "lineseq") { # braces w/o scope => elsif - my $head = "if ($cond) {\n\t$true\n\b}"; - my @elsifs; - while (!null($false) and $false->name eq "lineseq") { - my $newop = $false->first->sibling->first; - my $newcond = $newop->first; - my $newtrue = $newcond->sibling; - $false = $newtrue->sibling; # last in chain is OP_AND => no else - $newcond = $self->deparse($newcond, 1); - $newtrue = $self->deparse($newtrue, 0); - push @elsifs, "elsif ($newcond) {\n\t$newtrue\n\b}"; - } - if (!null($false)) { - $false = $cuddle . "else {\n\t" . - $self->deparse($false, 0) . "\n\b}\cK"; - } else { - $false = "\cK"; - } - return $head . join($cuddle, "", @elsifs) . $false; + my $head = "if ($cond) {\n\t$true\n\b}"; + my @elsifs; + while (!null($false) and is_ifelse_cont($false)) { + my $newop = $false->first; + my $newcond = $newop->first; + my $newtrue = $newcond->sibling; + $false = $newtrue->sibling; # last in chain is OP_AND => no else + $newcond = $self->deparse($newcond, 1); + $newtrue = $self->deparse($newtrue, 0); + push @elsifs, "elsif ($newcond) {\n\t$newtrue\n\b}"; } - $false = $self->deparse($false, 0); - return "if ($cond) {\n\t$true\n\b}${cuddle}else {\n\t$false\n\b}\cK"; + if (!null($false)) { + $false = $cuddle . "else {\n\t" . + $self->deparse($false, 0) . "\n\b}\cK"; + } else { + $false = "\cK"; + } + return $head . join($cuddle, "", @elsifs) . $false; } -sub pp_leaveloop { +sub loop_common { my $self = shift; - my($op, $cx) = @_; + my($op, $cx, $init) = @_; my $enter = $op->first; my $kid = $enter->sibling; local($self->{'curstash'}) = $self->{'curstash'}; my $head = ""; my $bare = 0; + my $body; + my $cond = undef; if ($kid->name eq "lineseq") { # bare or infinite loop if (is_state $kid->last) { # infinite $head = "for (;;) "; # shorter than while (1) + $cond = ""; } else { $bare = 1; } + $body = $kid; } elsif ($enter->name eq "enteriter") { # foreach my $ary = $enter->first->sibling; # first was pushmark my $var = $ary->sibling; @@ -1737,62 +1776,60 @@ sub pp_leaveloop { $var = "\$" . $self->deparse($var, 1); } $head = "foreach $var ($ary) "; - $kid = $kid->first->first->sibling; # skip OP_AND and OP_ITER + $body = $kid->first->first->sibling; # skip OP_AND and OP_ITER } elsif ($kid->name eq "null") { # while/until $kid = $kid->first; - my $name = {"and" => "while", "or" => "until"} - ->{$kid->name}; - $head = "$name (" . $self->deparse($kid->first, 1) . ") "; - $kid = $kid->first->sibling; + my $name = {"and" => "while", "or" => "until"}->{$kid->name}; + $cond = $self->deparse($kid->first, 1); + $head = "$name ($cond) "; + $body = $kid->first->sibling; } elsif ($kid->name eq "stub") { # bare and empty return "{;}"; # {} could be a hashref } - # The third-to-last kid is the continue block if the pointer used - # by `next BLOCK' points to its first OP, which happens to be the - # the op_next of the head of the _previous_ statement. - # Unless it's a bare loop, in which case it's last, since there's - # no unstack or extra nextstate. - # Except if the previous head isn't null but the first kid is - # (because it's a nulled out nextstate in a scope), in which - # case the head's next is advanced past the null but the nextop's - # isn't, so we need to try nextop->next. - my $precont; - my $cont = $kid->first; - if ($bare) { - while (!null($cont->sibling)) { - $precont = $cont; - $cont = $cont->sibling; - } - } else { - while (!null($cont->sibling->sibling->sibling)) { - $precont = $cont; - $cont = $cont->sibling; + # If there isn't a continue block, then the next pointer for the loop + # will point to the unstack, which is kid's penultimate child, except + # in a bare loop, when it will point to the leaveloop. When neither of + # these conditions hold, then the third-to-last child in the continue + # 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 ($bare) { + $cont = $body->last; + } else { + $cont = $body->first; + while (!null($cont->sibling->sibling->sibling)) { + $cont = $cont->sibling; + } + } + my $state = $body->first; + my $cuddle = $self->{'cuddle'}; + my @states; + for (; $$state != $$cont; $state = $state->sibling) { + push @states, $state; + } + $body = $self->lineseq(@states); + if (defined $cond and not is_scope $cont and $self->{'expand'} < 3) { + $head = "for ($init; $cond; " . $self->deparse($cont, 1) .") "; + $cont = "\cK"; + } else { + $cont = $cuddle . "continue {\n\t" . + $self->deparse($cont, 0) . "\n\b}\cK"; } - } - if ($precont and $ {$precont->next} == $ {$enter->nextop} - || $ {$precont->next} == $ {$enter->nextop->next} ) - { - my $state = $kid->first; - my $cuddle = $self->{'cuddle'}; - my($expr, @exprs); - for (; $$state != $$cont; $state = $state->sibling) { - $expr = ""; - if (is_state $state) { - $expr = $self->deparse($state, 0); - $state = $state->sibling; - last if null $kid; - } - $expr .= $self->deparse($state, 0); - push @exprs, $expr if $expr; - } - $kid = join(";\n", @exprs); - $cont = $cuddle . "continue {\n\t" . - $self->deparse($cont, 0) . "\n\b}\cK"; } else { $cont = "\cK"; - $kid = $self->deparse($kid, 0); + $body = $self->deparse($body, 0); } - return $head . "{\n\t" . $kid . "\n\b}" . $cont; + return $head . "{\n\t" . $body . "\n\b}" . $cont; +} + +sub pp_leaveloop { loop_common(@_, "") } + +sub for_loop { + my $self = shift; + my($op, $cx) = @_; + my $init = $self->deparse($op, 1); + return $self->loop_common($op->sibling, $cx, $init); } sub pp_leavetry { @@ -1814,7 +1851,7 @@ sub pp_null { } elsif ($op->first->name eq "enter") { return $self->pp_leave($op, $cx); } elsif ($op->targ == OP_STRINGIFY) { - return $self->dquote($op); + return $self->dquote($op, $cx); } elsif (!null($op->first->sibling) and $op->first->sibling->name eq "readline" and $op->first->sibling->flags & OPf_STACKED) { @@ -1832,21 +1869,10 @@ sub pp_null { } } -# the aassign in-common check messes up SvCUR (always setting it -# to a value >= 100), but it's probably safe to assume there -# won't be any NULs in the names of my() variables. (with -# stash variables, I wouldn't be so sure) -sub padname_fix { - my $str = shift; - $str = substr($str, 0, index($str, "\0")) if index($str, "\0") != -1; - return $str; -} - sub padname { my $self = shift; my $targ = shift; - my $str = $self->padname_sv($targ)->PV; - return padname_fix($str); + return $self->padname_sv($targ)->PVX; } sub padany { @@ -1879,37 +1905,34 @@ sub pp_threadsv { return $self->maybe_local($op, $cx, "\$" . $threadsv_names[$op->targ]); } -sub maybe_padgv { +sub gv_or_padgv { my $self = shift; my $op = shift; - my $gv; - if ($Config{useithreads}) { - $gv = $self->padval($op->padix); + if (class($op) eq "PADOP") { + return $self->padval($op->padix); + } else { # class($op) eq "SVOP" + return $op->gv; } - else { - $gv = $op->gv; - } - return $gv; } sub pp_gvsv { my $self = shift; my($op, $cx) = @_; - my $gv = $self->maybe_padgv($op); + my $gv = $self->gv_or_padgv($op); return $self->maybe_local($op, $cx, "\$" . $self->gv_name($gv)); } sub pp_gv { my $self = shift; my($op, $cx) = @_; - my $gv = $self->maybe_padgv($op); + my $gv = $self->gv_or_padgv($op); return $self->gv_name($gv); } sub pp_aelemfast { my $self = shift; my($op, $cx) = @_; - my $gv = $self->maybe_padgv($op); + my $gv = $self->gv_or_padgv($op); return "\$" . $self->gv_name($gv) . "[" . $op->private . "]"; } @@ -2220,7 +2243,7 @@ sub pp_entersub { $amper = "&"; $kid = "{" . $self->deparse($kid, 0) . "}"; } elsif ($kid->first->name eq "gv") { - my $gv = $self->maybe_padgv($kid->first); + my $gv = $self->gv_or_padgv($kid->first); if (class($gv->CV) ne "SPECIAL") { $proto = $gv->CV->PV if $gv->CV->FLAGS & SVf_POK; } @@ -2252,9 +2275,9 @@ sub pp_entersub { } else { if (defined $proto and $proto eq "") { return $kid; - } elsif ($proto eq "\$") { + } elsif (defined $proto and $proto eq "\$") { return $self->maybe_parens_func($kid, $args, $cx, 16); - } elsif ($proto or $simple) { + } elsif (defined($proto) && $proto or $simple) { return $self->maybe_parens_func($kid, $args, $cx, 5); } else { return "$kid(" . $args . ")"; @@ -2350,7 +2373,7 @@ sub const { if (class($sv) eq "SPECIAL") { return ('undef', '1', '0')[$$sv-1]; # sv_undef, sv_yes, sv_no } elsif ($sv->FLAGS & SVf_IOK) { - return $sv->IV; + return $sv->int_value; } elsif ($sv->FLAGS & SVf_NOK) { return $sv->NV; } elsif ($sv->FLAGS & SVf_ROK) { @@ -2381,7 +2404,9 @@ sub pp_const { # return $self->const_sv($op)->PV; # } my $sv = $self->const_sv($op); - return const($sv); +# return const($sv); + my $c = const $sv; + return $c =~ /^-\d/ ? $self->maybe_parens($c, $cx, 21) : $c; } sub dq { @@ -2391,7 +2416,13 @@ sub dq { if ($type eq "const") { return uninterp(escape_str(unback($self->const_sv($op)->PV))); } elsif ($type eq "concat") { - return $self->dq($op->first) . $self->dq($op->last); + my $first = $self->dq($op->first); + my $last = $self->dq($op->last); + # Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]" + if ($last =~ /^[{\[\w]/) { + $first =~ s/([%\$@])([A-Za-z_]\w*)$/${1}{$2}/; + } + return $first . $last; } elsif ($type eq "uc") { return '\U' . $self->dq($op->first->sibling) . '\E'; } elsif ($type eq "lc") { @@ -2418,7 +2449,7 @@ sub pp_backtick { sub dquote { my $self = shift; - my($op, $cx) = shift; + my($op, $cx) = @_; my $kid = $op->first->sibling; # skip ex-stringify, pushmark return $self->deparse($kid, $cx) if $self->{'unquote'}; $self->maybe_targmy($kid, $cx, @@ -2486,7 +2517,7 @@ sub pchr { # ASCII sub collapse { my(@chars) = @_; - my($c, $str, $tr); + my($str, $c, $tr) = (""); for ($c = 0; $c < @chars; $c++) { $tr = $chars[$c]; $str .= pchr($tr); @@ -2539,7 +2570,7 @@ sub tr_decode_byte { } @from = @newfrom; } - unless ($flags & OPpTRANS_DELETE) { + unless ($flags & OPpTRANS_DELETE || !@to) { pop @to while $#to and $to[$#to] == $to[$#to -1]; } my($from, $to); @@ -2678,9 +2709,15 @@ sub re_dq { my $op = shift; my $type = $op->name; if ($type eq "const") { - return uninterp($self->const_sv($op)->PV); + return re_uninterp($self->const_sv($op)->PV); } elsif ($type eq "concat") { - return $self->re_dq($op->first) . $self->re_dq($op->last); + my $first = $self->re_dq($op->first); + my $last = $self->re_dq($op->last); + # Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]" + if ($last =~ /^[{\[\w]/) { + $first =~ s/([%\$@])([A-Za-z_]\w*)$/${1}{$2}/; + } + return $first . $last; } elsif ($type eq "uc") { return '\U' . $self->re_dq($op->first->sibling) . '\E'; } elsif ($type eq "lc") { @@ -2842,8 +2879,8 @@ B::Deparse - Perl compiler backend to produce perl code =head1 SYNOPSIS -B B<-MO=Deparse>[B<,-u>I][B<,-p>][B<,-q>][B<,-l>][B<,-s>I] - I +B B<-MO=Deparse>[B<,-u>I][B<,-p>][B<,-q>][B<,-l>] + [B<,-s>I][B<,-x>I] I =head1 DESCRIPTION @@ -2988,6 +3025,55 @@ file is compiled as a main program. =back +=item B<-x>I + +Expand conventional syntax constructions into equivalent ones that expose +their internal operation. I should be a digit, with higher values +meaning more expansion. As with B<-q>, this actually involves turning off +special cases in B::Deparse's normal operations. + +If I is at least 3, for loops will be translated into equivalent +while loops with continue blocks; for instance + + for ($i = 0; $i < 10; ++$i) { + print $i; + } + +turns into + + $i = 0; + while ($i < 10) { + print $i; + } continue { + ++$i + } + +Note that in a few cases this translation can't be perfectly carried back +into the source code -- if the loop's initializer declares a my variable, +for instance, it won't have the correct scope outside of the loop. + +If I is at least 7, if statements will be translated into equivalent +expressions using C<&&>, C and C; for instance + + print 'hi' if $nice; + if ($nice) { + print 'hi'; + } + if ($nice) { + print 'hi'; + } else { + print 'bye'; + } + +turns into + + $nice and print 'hi'; + $nice and do { print 'hi' }; + $nice ? do { print 'hi' } : do { print 'bye' }; + +Long sequences of elsifs will turn into nested ternary operators, which +B::Deparse doesn't know how to indent nicely. + =back =head1 USING B::Deparse AS A MODULE @@ -3034,7 +3120,7 @@ See the 'to do' list at the beginning of the module file. =head1 AUTHOR -Stephen McCamant , based on an earlier +Stephen McCamant , based on an earlier version by Malcolm Beattie , with contributions from Gisle Aas, James Duncan, Albert Dvornik, Hugo van der Sanden, Gurusamy Sarathy, and Nick Ing-Simmons. diff --git a/contrib/perl5/ext/B/B/Disassembler.pm b/contrib/perl5/ext/B/B/Disassembler.pm index d054a2d16473..212532b9ce91 100644 --- a/contrib/perl5/ext/B/B/Disassembler.pm +++ b/contrib/perl5/ext/B/B/Disassembler.pm @@ -31,6 +31,13 @@ sub GET_U16 { return unpack("n", $str); } +sub GET_NV { + my $fh = shift; + my $str = $fh->readn(8); + croak "reached EOF while reading NV" unless length($str) == 8; + return unpack("N", $str); +} + sub GET_U32 { my $fh = shift; my $str = $fh->readn(4); diff --git a/contrib/perl5/ext/B/B/Lint.pm b/contrib/perl5/ext/B/B/Lint.pm index ed0d07dfcbd6..094b3cf8fd00 100644 --- a/contrib/perl5/ext/B/B/Lint.pm +++ b/contrib/perl5/ext/B/B/Lint.pm @@ -116,7 +116,7 @@ Malcolm Beattie, mbeattie@sable.ox.ac.uk. =cut use strict; -use B qw(walkoptree_slow main_root walksymtable svref_2object parents +use B qw(walkoptree main_root walksymtable svref_2object parents OPf_WANT_LIST OPf_WANT OPf_STACKED G_ARRAY ); @@ -277,12 +277,12 @@ sub B::GV::lintcv { return if !$$cv || $done_cv{$$cv}++; my $root = $cv->ROOT; #warn " root = $root (0x$$root)\n";#debug - walkoptree_slow($root, "lint") if $$root; + walkoptree($root, "lint") if $$root; } sub do_lint { my %search_pack; - walkoptree_slow(main_root, "lint") if ${main_root()}; + walkoptree(main_root, "lint") if ${main_root()}; # Now do subs in main no strict qw(vars refs); diff --git a/contrib/perl5/ext/B/B/Showlex.pm b/contrib/perl5/ext/B/B/Showlex.pm index 648f95dcc0a3..842ca3ee2b86 100644 --- a/contrib/perl5/ext/B/B/Showlex.pm +++ b/contrib/perl5/ext/B/B/Showlex.pm @@ -12,7 +12,24 @@ use B::Terse (); # to see the names of file scope lexicals used by bar.pl # -sub showarray { +sub shownamearray { + my ($name, $av) = @_; + my @els = $av->ARRAY; + my $count = @els; + my $i; + print "$name has $count entries\n"; + for ($i = 0; $i < $count; $i++) { + print "$i: "; + my $sv = $els[$i]; + if (class($sv) ne "SPECIAL") { + printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->PVX; + } else { + $sv->terse; + } + } +} + +sub showvaluearray { my ($name, $av) = @_; my @els = $av->ARRAY; my $count = @els; @@ -26,8 +43,8 @@ sub showarray { sub showlex { my ($objname, $namesav, $valsav) = @_; - showarray("Pad of lexical names for $objname", $namesav); - showarray("Pad of lexical values for $objname", $valsav); + shownamearray("Pad of lexical names for $objname", $namesav); + showvaluearray("Pad of lexical values for $objname", $valsav); } sub showlex_obj { diff --git a/contrib/perl5/ext/B/B/Stash.pm b/contrib/perl5/ext/B/B/Stash.pm index 0a3543eed41e..f3a82478777d 100644 --- a/contrib/perl5/ext/B/B/Stash.pm +++ b/contrib/perl5/ext/B/B/Stash.pm @@ -2,11 +2,19 @@ # vishalb@hotmail.com package B::Stash; +=pod + +=head1 NAME + +B::Stash - show what stashes are loaded + +=cut + BEGIN { %Seen = %INC } CHECK { my @arr=scan($main::{"main::"}); - @arr=map{s/\:\:$//;$_;} @arr; + @arr=map{s/\:\:$//;$_ eq ""?():$_;} @arr; print "-umain,-u", join (",-u",@arr) ,"\n"; } sub scan{ diff --git a/contrib/perl5/ext/B/B/Terse.pm b/contrib/perl5/ext/B/B/Terse.pm index 66b5cfc2f2f0..52f0549911e4 100644 --- a/contrib/perl5/ext/B/B/Terse.pm +++ b/contrib/perl5/ext/B/B/Terse.pm @@ -1,7 +1,7 @@ package B::Terse; use strict; -use B qw(peekop class walkoptree_slow walkoptree_exec - main_start main_root cstring svref_2object); +use B qw(peekop class walkoptree walkoptree_exec walkoptree_slow + main_start main_root cstring svref_2object SVf_IVisUV); use B::Asmdata qw(@specialsv_name); sub terse { @@ -15,7 +15,7 @@ sub terse { } sub compile { - my $order = shift; + my $order = @_ ? shift : ""; my @options = @_; B::clearsym(); if (@options) { @@ -37,7 +37,7 @@ sub compile { } sub indent { - my $level = shift; + my $level = @_ ? shift : 0; return " " x $level; } @@ -102,13 +102,14 @@ sub B::GV::terse { $stash = $stash . "::"; } print indent($level); - printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->NAME; + printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->SAFENAME; } sub B::IV::terse { my ($sv, $level) = @_; print indent($level); - printf "%s (0x%lx) %d\n", class($sv), $$sv, $sv->IV; + my $v = $sv->FLAGS & SVf_IVisUV ? "%u" : "%d"; + printf "%s (0x%lx) $v\n", class($sv), $$sv, $sv->int_value; } sub B::NV::terse { diff --git a/contrib/perl5/ext/B/Makefile.PL b/contrib/perl5/ext/B/Makefile.PL index cb9696bf4164..dcf6a1db15b2 100644 --- a/contrib/perl5/ext/B/Makefile.PL +++ b/contrib/perl5/ext/B/Makefile.PL @@ -1,5 +1,6 @@ use ExtUtils::MakeMaker; use Config; +use File::Spec; my $e = $Config{'exe_ext'}; my $o = $Config{'obj_ext'}; @@ -29,8 +30,19 @@ sub post_constants { "\nLIBS = $Config::Config{libs}\n" } -sub postamble { -' -B$(OBJ_EXT) : defsubs.h -' +sub upupfile { + File::Spec->catfile(File::Spec->updir, + File::Spec->updir, $_[0]); +} + +sub MY::postamble { + my $op_h = upupfile('op.h'); + my $cop_h = upupfile('cop.h'); + my $noecho = shift->{NOECHO}; +" +B\$(OBJ_EXT) : defsubs.h + +defsubs.h :: $op_h $cop_h + $noecho \$(NOOP) +" } diff --git a/contrib/perl5/ext/B/O.pm b/contrib/perl5/ext/B/O.pm index 352f8d42069e..2ef91edbd92d 100644 --- a/contrib/perl5/ext/B/O.pm +++ b/contrib/perl5/ext/B/O.pm @@ -1,5 +1,5 @@ package O; -use B qw(minus_c); +use B qw(minus_c save_BEGINs); use Carp; sub import { @@ -11,6 +11,7 @@ sub import { my $compilesub = &{"B::${backend}::compile"}(@options); if (ref($compilesub) eq "CODE") { minus_c; + save_BEGINs; eval 'CHECK { &$compilesub() }'; } else { die $compilesub; diff --git a/contrib/perl5/ext/B/defsubs_h.PL b/contrib/perl5/ext/B/defsubs_h.PL index 80ef936fcecf..da6566b0d717 100644 --- a/contrib/perl5/ext/B/defsubs_h.PL +++ b/contrib/perl5/ext/B/defsubs_h.PL @@ -6,16 +6,23 @@ my ($out) = __FILE__ =~ /(^.*)\.PL/i; $out =~ s/_h$/.h/; open(OUT,">$out") || die "Cannot open $file:$!"; print "Extracting $out...\n"; -foreach my $const (qw(AVf_REAL +foreach my $const (qw( + AVf_REAL HEf_SVKEY + SVf_READONLY SVTYPEMASK + GVf_IMPORTED_AV GVf_IMPORTED_HV + GVf_IMPORTED_SV GVf_IMPORTED_CV + CVf_METHOD CVf_LOCKED CVf_LVALUE SVf_IOK SVf_IVisUV SVf_NOK SVf_POK - SVf_ROK SVp_IOK SVp_POK )) + SVf_ROK SVp_IOK SVp_POK SVp_NOK + )) { doconst($const); } foreach my $file (qw(op.h cop.h)) { - open(OPH,"../../$file") || die "Cannot open ../../$file:$!"; + my $path = $^O eq 'MacOS' ? ":::$file" : "../../$file"; + open(OPH,"$path") || die "Cannot open $path:$!"; while () { doconst($1) if (/#define\s+(\w+)\s+([\(\)\|\dx]+)\s*(?:$|\/\*)/); diff --git a/contrib/perl5/ext/B/ramblings/flip-flop b/contrib/perl5/ext/B/ramblings/flip-flop index e0cb8ff62052..e08333d172db 100644 --- a/contrib/perl5/ext/B/ramblings/flip-flop +++ b/contrib/perl5/ext/B/ramblings/flip-flop @@ -9,13 +9,13 @@ PP(pp_range) } pp_range is a LOGOP. -In array context, it just returns op_next. +In list context, it just returns op_next. In scalar context it checks the truth of targ and returns op_other if true, op_next if false. flip is an UNOP. It "looks after" its child which is always a pp_range LOGOP. -In array context, it just returns the child's op_other. +In list context, it just returns the child's op_other. In scalar context, there are three possible outcomes: (1) set child's targ to 1, our targ to 1 and return op_next. (2) set child's targ to 1, our targ to 0, sp-- and return child's op_other. diff --git a/contrib/perl5/ext/ByteLoader/ByteLoader.pm b/contrib/perl5/ext/ByteLoader/ByteLoader.pm index 286d74697eec..9c8c84d677c2 100644 --- a/contrib/perl5/ext/ByteLoader/ByteLoader.pm +++ b/contrib/perl5/ext/ByteLoader/ByteLoader.pm @@ -2,7 +2,7 @@ package ByteLoader; use XSLoader (); -$VERSION = 0.03; +$VERSION = 0.04; XSLoader::load 'ByteLoader', $VERSION; @@ -17,10 +17,10 @@ ByteLoader - load byte compiled perl code =head1 SYNOPSIS - use ByteLoader 0.03; + use ByteLoader 0.04; - use ByteLoader 0.03; + use ByteLoader 0.04; =head1 DESCRIPTION diff --git a/contrib/perl5/ext/ByteLoader/ByteLoader.xs b/contrib/perl5/ext/ByteLoader/ByteLoader.xs index 7c3746bba70d..05b795ca25d7 100644 --- a/contrib/perl5/ext/ByteLoader/ByteLoader.xs +++ b/contrib/perl5/ext/ByteLoader/ByteLoader.xs @@ -4,47 +4,95 @@ #include "XSUB.h" #include "byterun.h" -static int -xgetc(PerlIO *io) +/* Something arbitary for a buffer size */ +#define BYTELOADER_BUFFER 8096 + +int +bl_getc(struct byteloader_fdata *data) { dTHX; - return PerlIO_getc(io); + if (SvCUR(data->datasv) <= data->next_out) { + int result; + /* Run out of buffered data, so attempt to read some more */ + *(SvPV_nolen (data->datasv)) = '\0'; + SvCUR_set (data->datasv, 0); + data->next_out = 0; + result = FILTER_READ (data->idx + 1, data->datasv, BYTELOADER_BUFFER); + + /* Filter returned error, or we got EOF and no data, then return EOF. + Not sure if filter is allowed to return EOF and add data simultaneously + Think not, but will bullet proof against it. */ + if (result < 0 || SvCUR(data->datasv) == 0) + return EOF; + /* Else there must be at least one byte present, which is good enough */ + } + + return *((char *) SvPV_nolen (data->datasv) + data->next_out++); } -static int -xfread(char *buf, size_t size, size_t n, PerlIO *io) +int +bl_read(struct byteloader_fdata *data, char *buf, size_t size, size_t n) { dTHX; - int i = PerlIO_read(io, buf, n * size); - if (i > 0) - i /= size; - return i; -} + char *start; + STRLEN len; + size_t wanted = size * n; -static void -freadpv(U32 len, void *data, XPV *pv) -{ - dTHX; - New(666, pv->xpv_pv, len, char); - PerlIO_read((PerlIO*)data, (void*)pv->xpv_pv, len); - pv->xpv_len = len; - pv->xpv_cur = len - 1; + start = SvPV (data->datasv, len); + if (len < (data->next_out + wanted)) { + int result; + + /* Shuffle data to start of buffer */ + len -= data->next_out; + if (len) { + memmove (start, start + data->next_out, len + 1); + SvCUR_set (data->datasv, len); + } else { + *start = '\0'; /* Avoid call to memmove. */ + SvCUR_set (data->datasv, 0); + } + data->next_out = 0; + + /* Attempt to read more data. */ + do { + result = FILTER_READ (data->idx + 1, data->datasv, BYTELOADER_BUFFER); + + start = SvPV (data->datasv, len); + } while (result > 0 && len < wanted); + /* Loop while not (EOF || error) and short reads */ + + /* If not enough data read, truncate copy */ + if (wanted > len) + wanted = len; + } + + if (wanted > 0) { + memcpy (buf, start + data->next_out, wanted); + data->next_out += wanted; + wanted /= size; + } + return (int) wanted; } static I32 byteloader_filter(pTHXo_ int idx, SV *buf_sv, int maxlen) { - dTHR; OP *saveroot = PL_main_root; OP *savestart = PL_main_start; - struct bytestream bs; + struct byteloader_state bstate; + struct byteloader_fdata data; - bs.data = PL_rsfp; - bs.pfgetc = (int(*) (void*))xgetc; - bs.pfread = (int(*) (char*,size_t,size_t,void*))xfread; - bs.pfreadpv = freadpv; + data.next_out = 0; + data.datasv = FILTER_DATA(idx); + data.idx = idx; - byterun(aTHXo_ bs); + bstate.bs_fdata = &data; + bstate.bs_obj_list = Null(void**); + bstate.bs_obj_list_fill = -1; + bstate.bs_sv = Nullsv; + bstate.bs_iv_overflows = 0; + + byterun(aTHXo_ &bstate); if (PL_in_eval) { OP *o; @@ -70,8 +118,12 @@ PROTOTYPES: ENABLE void import(...) + PREINIT: + SV *sv = newSVpvn ("", 0); PPCODE: - filter_add(byteloader_filter, NULL); + if (!sv) + croak ("Could not allocate ByteLoader buffers"); + filter_add(byteloader_filter, sv); void unimport(...) diff --git a/contrib/perl5/ext/ByteLoader/bytecode.h b/contrib/perl5/ext/ByteLoader/bytecode.h index 1621fed4eba4..c6acd28436dc 100644 --- a/contrib/perl5/ext/ByteLoader/bytecode.h +++ b/contrib/perl5/ext/ByteLoader/bytecode.h @@ -5,29 +5,33 @@ typedef char *op_tr_array; typedef int comment_t; typedef SV *svindex; typedef OP *opindex; +typedef char *pvindex; typedef IV IV64; #define BGET_FREAD(argp, len, nelem) \ - bs.pfread((char*)(argp),(len),(nelem),bs.data) -#define BGET_FGETC() bs.pfgetc(bs.data) + bl_read(bstate->bs_fdata,(char*)(argp),(len),(nelem)) +#define BGET_FGETC() bl_getc(bstate->bs_fdata) #define BGET_U32(arg) \ - BGET_FREAD(&arg, sizeof(U32), 1); arg = PerlSock_ntohl((U32)arg) + BGET_FREAD(&arg, sizeof(U32), 1) #define BGET_I32(arg) \ - BGET_FREAD(&arg, sizeof(I32), 1); arg = (I32)PerlSock_ntohl((U32)arg) + BGET_FREAD(&arg, sizeof(I32), 1) #define BGET_U16(arg) \ - BGET_FREAD(&arg, sizeof(U16), 1); arg = PerlSock_ntohs((U16)arg) + BGET_FREAD(&arg, sizeof(U16), 1) #define BGET_U8(arg) arg = BGET_FGETC() -#define BGET_PV(arg) STMT_START { \ - BGET_U32(arg); \ - if (arg) \ - bs.pfreadpv(arg, bs.data, &bytecode_pv); \ - else { \ - bytecode_pv.xpv_pv = 0; \ - bytecode_pv.xpv_len = 0; \ - bytecode_pv.xpv_cur = 0; \ - } \ +#define BGET_PV(arg) STMT_START { \ + BGET_U32(arg); \ + if (arg) { \ + New(666, bstate->bs_pv.xpv_pv, arg, char); \ + bl_read(bstate->bs_fdata, (void*)bstate->bs_pv.xpv_pv, arg, 1); \ + bstate->bs_pv.xpv_len = arg; \ + bstate->bs_pv.xpv_cur = arg - 1; \ + } else { \ + bstate->bs_pv.xpv_pv = 0; \ + bstate->bs_pv.xpv_len = 0; \ + bstate->bs_pv.xpv_cur = 0; \ + } \ } STMT_END #ifdef BYTELOADER_LOG_COMMENTS @@ -63,22 +67,20 @@ typedef IV IV64; arg = (I32)lo; \ } \ else { \ - bytecode_iv_overflows++; \ + bstate->bs_iv_overflows++; \ arg = 0; \ } \ } STMT_END -#define BGET_op_tr_array(arg) do { \ - unsigned short *ary; \ - int i; \ - New(666, ary, 256, unsigned short); \ - BGET_FREAD(ary, 256, 2); \ - for (i = 0; i < 256; i++) \ - ary[i] = PerlSock_ntohs(ary[i]); \ - arg = (char *) ary; \ +#define BGET_op_tr_array(arg) do { \ + unsigned short *ary; \ + int i; \ + New(666, ary, 256, unsigned short); \ + BGET_FREAD(ary, sizeof(unsigned short), 256); \ + arg = (char *) ary; \ } while (0) -#define BGET_pvcontents(arg) arg = bytecode_pv.xpv_pv +#define BGET_pvcontents(arg) arg = bstate->bs_pv.xpv_pv #define BGET_strconst(arg) STMT_START { \ for (arg = PL_tokenbuf; (*arg = BGET_FGETC()); arg++) /* nothing */; \ arg = PL_tokenbuf; \ @@ -91,14 +93,21 @@ typedef IV IV64; } STMT_END #define BGET_objindex(arg, type) STMT_START { \ - U32 ix; \ BGET_U32(ix); \ - arg = (type)bytecode_obj_list[ix]; \ + arg = (type)bstate->bs_obj_list[ix]; \ } STMT_END #define BGET_svindex(arg) BGET_objindex(arg, svindex) #define BGET_opindex(arg) BGET_objindex(arg, opindex) +#define BGET_pvindex(arg) STMT_START { \ + BGET_objindex(arg, pvindex); \ + arg = arg ? savepv(arg) : arg; \ + } STMT_END #define BSET_ldspecsv(sv, arg) sv = specialsv_list[arg] +#define BSET_stpv(pv, arg) STMT_START { \ + BSET_OBJ_STORE(pv, arg); \ + SAVEFREEPV(pv); \ + } STMT_END #define BSET_sv_refcnt_add(svrefcnt, arg) svrefcnt += arg #define BSET_gp_refcnt_add(gprefcnt, arg) gprefcnt += arg @@ -110,23 +119,29 @@ typedef IV IV64; #define BSET_gv_fetchpv(sv, arg) sv = (SV*)gv_fetchpv(arg, TRUE, SVt_PV) #define BSET_gv_stashpv(sv, arg) sv = (SV*)gv_stashpv(arg, TRUE) #define BSET_sv_magic(sv, arg) sv_magic(sv, Nullsv, arg, 0, 0) -#define BSET_mg_pv(mg, arg) mg->mg_ptr = arg; mg->mg_len = bytecode_pv.xpv_cur +#define BSET_mg_pv(mg, arg) mg->mg_ptr = arg; mg->mg_len = bstate->bs_pv.xpv_cur #define BSET_sv_upgrade(sv, arg) (void)SvUPGRADE(sv, arg) #define BSET_xpv(sv) do { \ - SvPV_set(sv, bytecode_pv.xpv_pv); \ - SvCUR_set(sv, bytecode_pv.xpv_cur); \ - SvLEN_set(sv, bytecode_pv.xpv_len); \ + SvPV_set(sv, bstate->bs_pv.xpv_pv); \ + SvCUR_set(sv, bstate->bs_pv.xpv_cur); \ + SvLEN_set(sv, bstate->bs_pv.xpv_len); \ } while (0) #define BSET_av_extend(sv, arg) av_extend((AV*)sv, arg) #define BSET_av_push(sv, arg) av_push((AV*)sv, arg) #define BSET_hv_store(sv, arg) \ - hv_store((HV*)sv, bytecode_pv.xpv_pv, bytecode_pv.xpv_cur, arg, 0) + hv_store((HV*)sv, bstate->bs_pv.xpv_pv, bstate->bs_pv.xpv_cur, arg, 0) #define BSET_pv_free(pv) Safefree(pv.xpv_pv) #define BSET_pregcomp(o, arg) \ ((PMOP*)o)->op_pmregexp = arg ? \ - CALLREGCOMP(aTHX_ arg, arg + bytecode_pv.xpv_cur, ((PMOP*)o)) : 0 -#define BSET_newsv(sv, arg) sv = NEWSV(666,0); SvUPGRADE(sv, arg) + CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.xpv_cur, ((PMOP*)o)) : 0 +#define BSET_newsv(sv, arg) \ + STMT_START { \ + sv = (arg == SVt_PVAV ? (SV*)newAV() : \ + arg == SVt_PVHV ? (SV*)newHV() : \ + NEWSV(666,0)); \ + SvUPGRADE(sv, arg); \ + } STMT_END #define BSET_newop(o, arg) ((o = (OP*)safemalloc(optype_size[arg])), \ memzero((char*)o,optype_size[arg])) #define BSET_newopn(o, arg) STMT_START { \ @@ -135,7 +150,10 @@ typedef IV IV64; oldop->op_next = o; \ } STMT_END -#define BSET_ret(foo) return +#define BSET_ret(foo) STMT_START { \ + Safefree(bstate->bs_obj_list); \ + return; \ + } STMT_END /* * Kludge special-case workaround for OP_MAPSTART @@ -152,10 +170,88 @@ typedef IV IV64; PL_comppad = (AV *)arg; \ pad = AvARRAY(arg); \ } STMT_END +/* this works now that Sarathy's changed the CopFILE_set macro to do the SvREFCNT_inc() + -- BKS 6-2-2000 */ #define BSET_cop_file(cop, arg) CopFILE_set(cop,arg) #define BSET_cop_line(cop, arg) CopLINE_set(cop,arg) #define BSET_cop_stashpv(cop, arg) CopSTASHPV_set(cop,arg) -#define BSET_OBJ_STORE(obj, ix) \ - (I32)ix > bytecode_obj_list_fill ? \ - bset_obj_store(aTHXo_ obj, (I32)ix) : (bytecode_obj_list[ix] = obj) +/* this is simply stolen from the code in newATTRSUB() */ +#define BSET_push_begin(ary,cv) \ + STMT_START { \ + I32 oldscope = PL_scopestack_ix; \ + ENTER; \ + SAVECOPFILE(&PL_compiling); \ + SAVECOPLINE(&PL_compiling); \ + save_svref(&PL_rs); \ + sv_setsv(PL_rs, PL_nrs); \ + if (!PL_beginav) \ + PL_beginav = newAV(); \ + av_push(PL_beginav, cv); \ + call_list(oldscope, PL_beginav); \ + PL_curcop = &PL_compiling; \ + PL_compiling.op_private = PL_hints; \ + LEAVE; \ + } STMT_END +#define BSET_push_init(ary,cv) \ + STMT_START { \ + av_unshift((PL_initav ? PL_initav : (PL_initav = newAV(), PL_initav)), 1); \ + av_store(PL_initav, 0, cv); \ + } STMT_END +#define BSET_push_end(ary,cv) \ + STMT_START { \ + av_unshift((PL_endav ? PL_endav : (PL_endav = newAV(), PL_endav)), 1); \ + av_store(PL_endav, 0, cv); \ + } STMT_END +#define BSET_OBJ_STORE(obj, ix) \ + (I32)ix > bstate->bs_obj_list_fill ? \ + bset_obj_store(aTHXo_ bstate, obj, (I32)ix) : (bstate->bs_obj_list[ix] = obj) + +/* NOTE: the bytecode header only sanity-checks the bytecode. If a script cares about + * what version of Perl it's being called under, it should do a 'require 5.6.0' or + * equivalent. However, since the header includes checks requiring an exact match in + * ByteLoader versions (we can't guarantee forward compatibility), you don't + * need to specify one: + * use ByteLoader; + * is all you need. + * -- BKS, June 2000 +*/ + +#define HEADER_FAIL(f) \ + Perl_croak(aTHX_ "Invalid bytecode for this architecture: " f) +#define HEADER_FAIL1(f, arg1) \ + Perl_croak(aTHX_ "Invalid bytecode for this architecture: " f, arg1) +#define HEADER_FAIL2(f, arg1, arg2) \ + Perl_croak(aTHX_ "Invalid bytecode for this architecture: " f, arg1, arg2) + +#define BYTECODE_HEADER_CHECK \ + STMT_START { \ + U32 sz = 0; \ + strconst str; \ + \ + BGET_U32(sz); /* Magic: 'PLBC' */ \ + if (sz != 0x43424c50) { \ + HEADER_FAIL1("bad magic (want 0x43424c50, got %#x)", (int)sz); \ + } \ + BGET_strconst(str); /* archname */ \ + if (strNE(str, ARCHNAME)) { \ + HEADER_FAIL2("wrong architecture (want %s, you have %s)",str,ARCHNAME); \ + } \ + BGET_strconst(str); /* ByteLoader version */ \ + if (strNE(str, VERSION)) { \ + HEADER_FAIL2("mismatched ByteLoader versions (want %s, you have %s)", \ + str, VERSION); \ + } \ + BGET_U32(sz); /* ivsize */ \ + if (sz != IVSIZE) { \ + HEADER_FAIL("different IVSIZE"); \ + } \ + BGET_U32(sz); /* ptrsize */ \ + if (sz != PTRSIZE) { \ + HEADER_FAIL("different PTRSIZE"); \ + } \ + BGET_strconst(str); /* byteorder */ \ + if (strNE(str, STRINGIFY(BYTEORDER))) { \ + HEADER_FAIL("different byteorder"); \ + } \ + } STMT_END diff --git a/contrib/perl5/ext/ByteLoader/byterun.c b/contrib/perl5/ext/ByteLoader/byterun.c index a1044ab2c0f2..71cd8aa08496 100644 --- a/contrib/perl5/ext/ByteLoader/byterun.c +++ b/contrib/perl5/ext/ByteLoader/byterun.c @@ -26,7 +26,7 @@ #include "bytecode.h" -static int optype_size[] = { +static const int optype_size[] = { sizeof(OP), sizeof(UNOP), sizeof(BINOP), @@ -40,38 +40,34 @@ static int optype_size[] = { sizeof(COP) }; -static SV *specialsv_list[4]; - -static int bytecode_iv_overflows = 0; -static SV *bytecode_sv; -static XPV bytecode_pv; -static void **bytecode_obj_list; -static I32 bytecode_obj_list_fill = -1; - void * -bset_obj_store(pTHXo_ void *obj, I32 ix) +bset_obj_store(pTHXo_ struct byteloader_state *bstate, void *obj, I32 ix) { - if (ix > bytecode_obj_list_fill) { - if (bytecode_obj_list_fill == -1) - New(666, bytecode_obj_list, ix + 1, void*); - else - Renew(bytecode_obj_list, ix + 1, void*); - bytecode_obj_list_fill = ix; + if (ix > bstate->bs_obj_list_fill) { + Renew(bstate->bs_obj_list, ix + 32, void*); + bstate->bs_obj_list_fill = ix + 31; } - bytecode_obj_list[ix] = obj; + bstate->bs_obj_list[ix] = obj; return obj; } void -byterun(pTHXo_ struct bytestream bs) +byterun(pTHXo_ register struct byteloader_state *bstate) { - dTHR; - int insn; + register int insn; + U32 ix; + SV *specialsv_list[6]; + + BYTECODE_HEADER_CHECK; /* croak if incorrect platform */ + New(666, bstate->bs_obj_list, 32, void*); /* set op objlist */ + bstate->bs_obj_list_fill = 31; specialsv_list[0] = Nullsv; specialsv_list[1] = &PL_sv_undef; specialsv_list[2] = &PL_sv_yes; specialsv_list[3] = &PL_sv_no; + specialsv_list[4] = pWARN_ALL; + specialsv_list[5] = pWARN_NONE; while ((insn = BGET_FGETC()) != EOF) { switch (insn) { @@ -95,7 +91,7 @@ byterun(pTHXo_ struct bytestream bs) { svindex arg; BGET_svindex(arg); - bytecode_sv = arg; + bstate->bs_sv = arg; break; } case INSN_LDOP: /* 2 */ @@ -109,7 +105,7 @@ byterun(pTHXo_ struct bytestream bs) { U32 arg; BGET_U32(arg); - BSET_OBJ_STORE(bytecode_sv, arg); + BSET_OBJ_STORE(bstate->bs_sv, arg); break; } case INSN_STOP: /* 4 */ @@ -119,610 +115,610 @@ byterun(pTHXo_ struct bytestream bs) BSET_OBJ_STORE(PL_op, arg); break; } - case INSN_LDSPECSV: /* 5 */ + case INSN_STPV: /* 5 */ + { + U32 arg; + BGET_U32(arg); + BSET_stpv(bstate->bs_pv.xpv_pv, arg); + break; + } + case INSN_LDSPECSV: /* 6 */ { U8 arg; BGET_U8(arg); - BSET_ldspecsv(bytecode_sv, arg); + BSET_ldspecsv(bstate->bs_sv, arg); break; } - case INSN_NEWSV: /* 6 */ + case INSN_NEWSV: /* 7 */ { U8 arg; BGET_U8(arg); - BSET_newsv(bytecode_sv, arg); + BSET_newsv(bstate->bs_sv, arg); break; } - case INSN_NEWOP: /* 7 */ + case INSN_NEWOP: /* 8 */ { U8 arg; BGET_U8(arg); BSET_newop(PL_op, arg); break; } - case INSN_NEWOPN: /* 8 */ + case INSN_NEWOPN: /* 9 */ { U8 arg; BGET_U8(arg); BSET_newopn(PL_op, arg); break; } - case INSN_NEWPV: /* 9 */ + case INSN_NEWPV: /* 11 */ { PV arg; BGET_PV(arg); break; } - case INSN_PV_CUR: /* 11 */ + case INSN_PV_CUR: /* 12 */ { STRLEN arg; BGET_U32(arg); - bytecode_pv.xpv_cur = arg; + bstate->bs_pv.xpv_cur = arg; break; } - case INSN_PV_FREE: /* 12 */ + case INSN_PV_FREE: /* 13 */ { - BSET_pv_free(bytecode_pv); + BSET_pv_free(bstate->bs_pv); break; } - case INSN_SV_UPGRADE: /* 13 */ + case INSN_SV_UPGRADE: /* 14 */ { char arg; BGET_U8(arg); - BSET_sv_upgrade(bytecode_sv, arg); + BSET_sv_upgrade(bstate->bs_sv, arg); break; } - case INSN_SV_REFCNT: /* 14 */ + case INSN_SV_REFCNT: /* 15 */ { U32 arg; BGET_U32(arg); - SvREFCNT(bytecode_sv) = arg; + SvREFCNT(bstate->bs_sv) = arg; break; } - case INSN_SV_REFCNT_ADD: /* 15 */ + case INSN_SV_REFCNT_ADD: /* 16 */ { I32 arg; BGET_I32(arg); - BSET_sv_refcnt_add(SvREFCNT(bytecode_sv), arg); + BSET_sv_refcnt_add(SvREFCNT(bstate->bs_sv), arg); break; } - case INSN_SV_FLAGS: /* 16 */ + case INSN_SV_FLAGS: /* 17 */ { U32 arg; BGET_U32(arg); - SvFLAGS(bytecode_sv) = arg; + SvFLAGS(bstate->bs_sv) = arg; break; } - case INSN_XRV: /* 17 */ + case INSN_XRV: /* 18 */ { svindex arg; BGET_svindex(arg); - SvRV(bytecode_sv) = arg; + SvRV(bstate->bs_sv) = arg; break; } - case INSN_XPV: /* 18 */ + case INSN_XPV: /* 19 */ { - BSET_xpv(bytecode_sv); + BSET_xpv(bstate->bs_sv); break; } - case INSN_XIV32: /* 19 */ + case INSN_XIV32: /* 20 */ { I32 arg; BGET_I32(arg); - SvIVX(bytecode_sv) = arg; + SvIVX(bstate->bs_sv) = arg; break; } - case INSN_XIV64: /* 20 */ + case INSN_XIV64: /* 21 */ { IV64 arg; BGET_IV64(arg); - SvIVX(bytecode_sv) = arg; + SvIVX(bstate->bs_sv) = arg; break; } - case INSN_XNV: /* 21 */ + case INSN_XNV: /* 22 */ { NV arg; BGET_NV(arg); - SvNVX(bytecode_sv) = arg; + SvNVX(bstate->bs_sv) = arg; break; } - case INSN_XLV_TARGOFF: /* 22 */ + case INSN_XLV_TARGOFF: /* 23 */ { STRLEN arg; BGET_U32(arg); - LvTARGOFF(bytecode_sv) = arg; + LvTARGOFF(bstate->bs_sv) = arg; break; } - case INSN_XLV_TARGLEN: /* 23 */ + case INSN_XLV_TARGLEN: /* 24 */ { STRLEN arg; BGET_U32(arg); - LvTARGLEN(bytecode_sv) = arg; + LvTARGLEN(bstate->bs_sv) = arg; break; } - case INSN_XLV_TARG: /* 24 */ + case INSN_XLV_TARG: /* 25 */ { svindex arg; BGET_svindex(arg); - LvTARG(bytecode_sv) = arg; + LvTARG(bstate->bs_sv) = arg; break; } - case INSN_XLV_TYPE: /* 25 */ + case INSN_XLV_TYPE: /* 26 */ { char arg; BGET_U8(arg); - LvTYPE(bytecode_sv) = arg; + LvTYPE(bstate->bs_sv) = arg; break; } - case INSN_XBM_USEFUL: /* 26 */ + case INSN_XBM_USEFUL: /* 27 */ { I32 arg; BGET_I32(arg); - BmUSEFUL(bytecode_sv) = arg; + BmUSEFUL(bstate->bs_sv) = arg; break; } - case INSN_XBM_PREVIOUS: /* 27 */ + case INSN_XBM_PREVIOUS: /* 28 */ { U16 arg; BGET_U16(arg); - BmPREVIOUS(bytecode_sv) = arg; + BmPREVIOUS(bstate->bs_sv) = arg; break; } - case INSN_XBM_RARE: /* 28 */ + case INSN_XBM_RARE: /* 29 */ { U8 arg; BGET_U8(arg); - BmRARE(bytecode_sv) = arg; + BmRARE(bstate->bs_sv) = arg; break; } - case INSN_XFM_LINES: /* 29 */ + case INSN_XFM_LINES: /* 30 */ { I32 arg; BGET_I32(arg); - FmLINES(bytecode_sv) = arg; + FmLINES(bstate->bs_sv) = arg; break; } - case INSN_XIO_LINES: /* 30 */ + case INSN_XIO_LINES: /* 31 */ { long arg; BGET_I32(arg); - IoLINES(bytecode_sv) = arg; + IoLINES(bstate->bs_sv) = arg; break; } - case INSN_XIO_PAGE: /* 31 */ + case INSN_XIO_PAGE: /* 32 */ { long arg; BGET_I32(arg); - IoPAGE(bytecode_sv) = arg; + IoPAGE(bstate->bs_sv) = arg; break; } - case INSN_XIO_PAGE_LEN: /* 32 */ + case INSN_XIO_PAGE_LEN: /* 33 */ { long arg; BGET_I32(arg); - IoPAGE_LEN(bytecode_sv) = arg; + IoPAGE_LEN(bstate->bs_sv) = arg; break; } - case INSN_XIO_LINES_LEFT: /* 33 */ + case INSN_XIO_LINES_LEFT: /* 34 */ { long arg; BGET_I32(arg); - IoLINES_LEFT(bytecode_sv) = arg; + IoLINES_LEFT(bstate->bs_sv) = arg; break; } - case INSN_XIO_TOP_NAME: /* 34 */ + case INSN_XIO_TOP_NAME: /* 36 */ { pvcontents arg; BGET_pvcontents(arg); - IoTOP_NAME(bytecode_sv) = arg; + IoTOP_NAME(bstate->bs_sv) = arg; break; } - case INSN_XIO_TOP_GV: /* 36 */ + case INSN_XIO_TOP_GV: /* 37 */ { svindex arg; BGET_svindex(arg); - *(SV**)&IoTOP_GV(bytecode_sv) = arg; + *(SV**)&IoTOP_GV(bstate->bs_sv) = arg; break; } - case INSN_XIO_FMT_NAME: /* 37 */ + case INSN_XIO_FMT_NAME: /* 38 */ { pvcontents arg; BGET_pvcontents(arg); - IoFMT_NAME(bytecode_sv) = arg; + IoFMT_NAME(bstate->bs_sv) = arg; break; } - case INSN_XIO_FMT_GV: /* 38 */ + case INSN_XIO_FMT_GV: /* 39 */ { svindex arg; BGET_svindex(arg); - *(SV**)&IoFMT_GV(bytecode_sv) = arg; + *(SV**)&IoFMT_GV(bstate->bs_sv) = arg; break; } - case INSN_XIO_BOTTOM_NAME: /* 39 */ + case INSN_XIO_BOTTOM_NAME: /* 40 */ { pvcontents arg; BGET_pvcontents(arg); - IoBOTTOM_NAME(bytecode_sv) = arg; + IoBOTTOM_NAME(bstate->bs_sv) = arg; break; } - case INSN_XIO_BOTTOM_GV: /* 40 */ + case INSN_XIO_BOTTOM_GV: /* 41 */ { svindex arg; BGET_svindex(arg); - *(SV**)&IoBOTTOM_GV(bytecode_sv) = arg; + *(SV**)&IoBOTTOM_GV(bstate->bs_sv) = arg; break; } - case INSN_XIO_SUBPROCESS: /* 41 */ + case INSN_XIO_SUBPROCESS: /* 42 */ { short arg; BGET_U16(arg); - IoSUBPROCESS(bytecode_sv) = arg; + IoSUBPROCESS(bstate->bs_sv) = arg; break; } - case INSN_XIO_TYPE: /* 42 */ + case INSN_XIO_TYPE: /* 43 */ { char arg; BGET_U8(arg); - IoTYPE(bytecode_sv) = arg; + IoTYPE(bstate->bs_sv) = arg; break; } - case INSN_XIO_FLAGS: /* 43 */ + case INSN_XIO_FLAGS: /* 44 */ { char arg; BGET_U8(arg); - IoFLAGS(bytecode_sv) = arg; + IoFLAGS(bstate->bs_sv) = arg; break; } - case INSN_XCV_STASH: /* 44 */ + case INSN_XCV_STASH: /* 45 */ { svindex arg; BGET_svindex(arg); - *(SV**)&CvSTASH(bytecode_sv) = arg; + *(SV**)&CvSTASH(bstate->bs_sv) = arg; break; } - case INSN_XCV_START: /* 45 */ + case INSN_XCV_START: /* 46 */ { opindex arg; BGET_opindex(arg); - CvSTART(bytecode_sv) = arg; + CvSTART(bstate->bs_sv) = arg; break; } - case INSN_XCV_ROOT: /* 46 */ + case INSN_XCV_ROOT: /* 47 */ { opindex arg; BGET_opindex(arg); - CvROOT(bytecode_sv) = arg; + CvROOT(bstate->bs_sv) = arg; break; } - case INSN_XCV_GV: /* 47 */ + case INSN_XCV_GV: /* 48 */ { svindex arg; BGET_svindex(arg); - *(SV**)&CvGV(bytecode_sv) = arg; + *(SV**)&CvGV(bstate->bs_sv) = arg; break; } - case INSN_XCV_FILE: /* 48 */ + case INSN_XCV_FILE: /* 49 */ { - pvcontents arg; - BGET_pvcontents(arg); - CvFILE(bytecode_sv) = arg; + pvindex arg; + BGET_pvindex(arg); + CvFILE(bstate->bs_sv) = arg; break; } - case INSN_XCV_DEPTH: /* 49 */ + case INSN_XCV_DEPTH: /* 50 */ { long arg; BGET_I32(arg); - CvDEPTH(bytecode_sv) = arg; + CvDEPTH(bstate->bs_sv) = arg; break; } - case INSN_XCV_PADLIST: /* 50 */ + case INSN_XCV_PADLIST: /* 51 */ { svindex arg; BGET_svindex(arg); - *(SV**)&CvPADLIST(bytecode_sv) = arg; + *(SV**)&CvPADLIST(bstate->bs_sv) = arg; break; } - case INSN_XCV_OUTSIDE: /* 51 */ + case INSN_XCV_OUTSIDE: /* 52 */ { svindex arg; BGET_svindex(arg); - *(SV**)&CvOUTSIDE(bytecode_sv) = arg; + *(SV**)&CvOUTSIDE(bstate->bs_sv) = arg; break; } - case INSN_XCV_FLAGS: /* 52 */ + case INSN_XCV_FLAGS: /* 53 */ { U16 arg; BGET_U16(arg); - CvFLAGS(bytecode_sv) = arg; + CvFLAGS(bstate->bs_sv) = arg; break; } - case INSN_AV_EXTEND: /* 53 */ + case INSN_AV_EXTEND: /* 54 */ { SSize_t arg; BGET_I32(arg); - BSET_av_extend(bytecode_sv, arg); + BSET_av_extend(bstate->bs_sv, arg); break; } - case INSN_AV_PUSH: /* 54 */ + case INSN_AV_PUSH: /* 55 */ { svindex arg; BGET_svindex(arg); - BSET_av_push(bytecode_sv, arg); + BSET_av_push(bstate->bs_sv, arg); break; } - case INSN_XAV_FILL: /* 55 */ + case INSN_XAV_FILL: /* 56 */ { SSize_t arg; BGET_I32(arg); - AvFILLp(bytecode_sv) = arg; + AvFILLp(bstate->bs_sv) = arg; break; } - case INSN_XAV_MAX: /* 56 */ + case INSN_XAV_MAX: /* 57 */ { SSize_t arg; BGET_I32(arg); - AvMAX(bytecode_sv) = arg; + AvMAX(bstate->bs_sv) = arg; break; } - case INSN_XAV_FLAGS: /* 57 */ + case INSN_XAV_FLAGS: /* 58 */ { U8 arg; BGET_U8(arg); - AvFLAGS(bytecode_sv) = arg; + AvFLAGS(bstate->bs_sv) = arg; break; } - case INSN_XHV_RITER: /* 58 */ + case INSN_XHV_RITER: /* 59 */ { I32 arg; BGET_I32(arg); - HvRITER(bytecode_sv) = arg; + HvRITER(bstate->bs_sv) = arg; break; } - case INSN_XHV_NAME: /* 59 */ + case INSN_XHV_NAME: /* 60 */ { pvcontents arg; BGET_pvcontents(arg); - HvNAME(bytecode_sv) = arg; + HvNAME(bstate->bs_sv) = arg; break; } - case INSN_HV_STORE: /* 60 */ + case INSN_HV_STORE: /* 61 */ { svindex arg; BGET_svindex(arg); - BSET_hv_store(bytecode_sv, arg); + BSET_hv_store(bstate->bs_sv, arg); break; } - case INSN_SV_MAGIC: /* 61 */ + case INSN_SV_MAGIC: /* 62 */ { char arg; BGET_U8(arg); - BSET_sv_magic(bytecode_sv, arg); + BSET_sv_magic(bstate->bs_sv, arg); break; } - case INSN_MG_OBJ: /* 62 */ + case INSN_MG_OBJ: /* 63 */ { svindex arg; BGET_svindex(arg); - SvMAGIC(bytecode_sv)->mg_obj = arg; + SvMAGIC(bstate->bs_sv)->mg_obj = arg; break; } - case INSN_MG_PRIVATE: /* 63 */ + case INSN_MG_PRIVATE: /* 64 */ { U16 arg; BGET_U16(arg); - SvMAGIC(bytecode_sv)->mg_private = arg; + SvMAGIC(bstate->bs_sv)->mg_private = arg; break; } - case INSN_MG_FLAGS: /* 64 */ + case INSN_MG_FLAGS: /* 65 */ { U8 arg; BGET_U8(arg); - SvMAGIC(bytecode_sv)->mg_flags = arg; + SvMAGIC(bstate->bs_sv)->mg_flags = arg; break; } - case INSN_MG_PV: /* 65 */ + case INSN_MG_PV: /* 66 */ { pvcontents arg; BGET_pvcontents(arg); - BSET_mg_pv(SvMAGIC(bytecode_sv), arg); + BSET_mg_pv(SvMAGIC(bstate->bs_sv), arg); break; } - case INSN_XMG_STASH: /* 66 */ + case INSN_XMG_STASH: /* 67 */ { svindex arg; BGET_svindex(arg); - *(SV**)&SvSTASH(bytecode_sv) = arg; + *(SV**)&SvSTASH(bstate->bs_sv) = arg; break; } - case INSN_GV_FETCHPV: /* 67 */ + case INSN_GV_FETCHPV: /* 68 */ { strconst arg; BGET_strconst(arg); - BSET_gv_fetchpv(bytecode_sv, arg); + BSET_gv_fetchpv(bstate->bs_sv, arg); break; } - case INSN_GV_STASHPV: /* 68 */ + case INSN_GV_STASHPV: /* 69 */ { strconst arg; BGET_strconst(arg); - BSET_gv_stashpv(bytecode_sv, arg); + BSET_gv_stashpv(bstate->bs_sv, arg); break; } - case INSN_GP_SV: /* 69 */ + case INSN_GP_SV: /* 70 */ { svindex arg; BGET_svindex(arg); - GvSV(bytecode_sv) = arg; + GvSV(bstate->bs_sv) = arg; break; } - case INSN_GP_REFCNT: /* 70 */ + case INSN_GP_REFCNT: /* 71 */ { U32 arg; BGET_U32(arg); - GvREFCNT(bytecode_sv) = arg; + GvREFCNT(bstate->bs_sv) = arg; break; } - case INSN_GP_REFCNT_ADD: /* 71 */ + case INSN_GP_REFCNT_ADD: /* 72 */ { I32 arg; BGET_I32(arg); - BSET_gp_refcnt_add(GvREFCNT(bytecode_sv), arg); + BSET_gp_refcnt_add(GvREFCNT(bstate->bs_sv), arg); break; } - case INSN_GP_AV: /* 72 */ + case INSN_GP_AV: /* 73 */ { svindex arg; BGET_svindex(arg); - *(SV**)&GvAV(bytecode_sv) = arg; + *(SV**)&GvAV(bstate->bs_sv) = arg; break; } - case INSN_GP_HV: /* 73 */ + case INSN_GP_HV: /* 74 */ { svindex arg; BGET_svindex(arg); - *(SV**)&GvHV(bytecode_sv) = arg; + *(SV**)&GvHV(bstate->bs_sv) = arg; break; } - case INSN_GP_CV: /* 74 */ + case INSN_GP_CV: /* 75 */ { svindex arg; BGET_svindex(arg); - *(SV**)&GvCV(bytecode_sv) = arg; + *(SV**)&GvCV(bstate->bs_sv) = arg; break; } - case INSN_GP_FILE: /* 75 */ + case INSN_GP_FILE: /* 76 */ { - pvcontents arg; - BGET_pvcontents(arg); - GvFILE(bytecode_sv) = arg; + pvindex arg; + BGET_pvindex(arg); + GvFILE(bstate->bs_sv) = arg; break; } - case INSN_GP_IO: /* 76 */ + case INSN_GP_IO: /* 77 */ { svindex arg; BGET_svindex(arg); - *(SV**)&GvIOp(bytecode_sv) = arg; + *(SV**)&GvIOp(bstate->bs_sv) = arg; break; } - case INSN_GP_FORM: /* 77 */ + case INSN_GP_FORM: /* 78 */ { svindex arg; BGET_svindex(arg); - *(SV**)&GvFORM(bytecode_sv) = arg; + *(SV**)&GvFORM(bstate->bs_sv) = arg; break; } - case INSN_GP_CVGEN: /* 78 */ + case INSN_GP_CVGEN: /* 79 */ { U32 arg; BGET_U32(arg); - GvCVGEN(bytecode_sv) = arg; + GvCVGEN(bstate->bs_sv) = arg; break; } - case INSN_GP_LINE: /* 79 */ + case INSN_GP_LINE: /* 80 */ { line_t arg; BGET_U16(arg); - GvLINE(bytecode_sv) = arg; + GvLINE(bstate->bs_sv) = arg; break; } - case INSN_GP_SHARE: /* 80 */ + case INSN_GP_SHARE: /* 81 */ { svindex arg; BGET_svindex(arg); - BSET_gp_share(bytecode_sv, arg); + BSET_gp_share(bstate->bs_sv, arg); break; } - case INSN_XGV_FLAGS: /* 81 */ + case INSN_XGV_FLAGS: /* 82 */ { U8 arg; BGET_U8(arg); - GvFLAGS(bytecode_sv) = arg; + GvFLAGS(bstate->bs_sv) = arg; break; } - case INSN_OP_NEXT: /* 82 */ + case INSN_OP_NEXT: /* 83 */ { opindex arg; BGET_opindex(arg); PL_op->op_next = arg; break; } - case INSN_OP_SIBLING: /* 83 */ + case INSN_OP_SIBLING: /* 84 */ { opindex arg; BGET_opindex(arg); PL_op->op_sibling = arg; break; } - case INSN_OP_PPADDR: /* 84 */ + case INSN_OP_PPADDR: /* 85 */ { strconst arg; BGET_strconst(arg); BSET_op_ppaddr(PL_op->op_ppaddr, arg); break; } - case INSN_OP_TARG: /* 85 */ + case INSN_OP_TARG: /* 86 */ { PADOFFSET arg; BGET_U32(arg); PL_op->op_targ = arg; break; } - case INSN_OP_TYPE: /* 86 */ + case INSN_OP_TYPE: /* 87 */ { OPCODE arg; BGET_U16(arg); BSET_op_type(PL_op, arg); break; } - case INSN_OP_SEQ: /* 87 */ + case INSN_OP_SEQ: /* 88 */ { U16 arg; BGET_U16(arg); PL_op->op_seq = arg; break; } - case INSN_OP_FLAGS: /* 88 */ + case INSN_OP_FLAGS: /* 89 */ { U8 arg; BGET_U8(arg); PL_op->op_flags = arg; break; } - case INSN_OP_PRIVATE: /* 89 */ + case INSN_OP_PRIVATE: /* 90 */ { U8 arg; BGET_U8(arg); PL_op->op_private = arg; break; } - case INSN_OP_FIRST: /* 90 */ + case INSN_OP_FIRST: /* 91 */ { opindex arg; BGET_opindex(arg); cUNOP->op_first = arg; break; } - case INSN_OP_LAST: /* 91 */ + case INSN_OP_LAST: /* 92 */ { opindex arg; BGET_opindex(arg); cBINOP->op_last = arg; break; } - case INSN_OP_OTHER: /* 92 */ + case INSN_OP_OTHER: /* 93 */ { opindex arg; BGET_opindex(arg); cLOGOP->op_other = arg; break; } - case INSN_OP_CHILDREN: /* 93 */ - { - U32 arg; - BGET_U32(arg); - cLISTOP->op_children = arg; - break; - } case INSN_OP_PMREPLROOT: /* 94 */ { opindex arg; @@ -823,22 +819,22 @@ byterun(pTHXo_ struct bytestream bs) } case INSN_COP_LABEL: /* 108 */ { - pvcontents arg; - BGET_pvcontents(arg); + pvindex arg; + BGET_pvindex(arg); cCOP->cop_label = arg; break; } case INSN_COP_STASHPV: /* 109 */ { - pvcontents arg; - BGET_pvcontents(arg); + pvindex arg; + BGET_pvindex(arg); BSET_cop_stashpv(cCOP, arg); break; } case INSN_COP_FILE: /* 110 */ { - pvcontents arg; - BGET_pvcontents(arg); + pvindex arg; + BGET_pvindex(arg); BSET_cop_file(cCOP, arg); break; } @@ -891,6 +887,27 @@ byterun(pTHXo_ struct bytestream bs) BSET_curpad(PL_curpad, arg); break; } + case INSN_PUSH_BEGIN: /* 118 */ + { + svindex arg; + BGET_svindex(arg); + BSET_push_begin(PL_beginav, arg); + break; + } + case INSN_PUSH_INIT: /* 119 */ + { + svindex arg; + BGET_svindex(arg); + BSET_push_init(PL_initav, arg); + break; + } + case INSN_PUSH_END: /* 120 */ + { + svindex arg; + BGET_svindex(arg); + BSET_push_end(PL_endav, arg); + break; + } default: Perl_croak(aTHX_ "Illegal bytecode instruction %d\n", insn); /* NOTREACHED */ diff --git a/contrib/perl5/ext/ByteLoader/byterun.h b/contrib/perl5/ext/ByteLoader/byterun.h index f0de6b482044..f074f2d6cf6f 100644 --- a/contrib/perl5/ext/ByteLoader/byterun.h +++ b/contrib/perl5/ext/ByteLoader/byterun.h @@ -8,108 +8,120 @@ /* * This file is autogenerated from bytecode.pl. Changes made here will be lost. */ -struct bytestream { - void *data; - int (*pfgetc)(void *); - int (*pfread)(char *, size_t, size_t, void *); - void (*pfreadpv)(U32, void *, XPV *); +struct byteloader_fdata { + SV *datasv; + int next_out; + int idx; }; +struct byteloader_state { + struct byteloader_fdata *bs_fdata; + SV *bs_sv; + void **bs_obj_list; + int bs_obj_list_fill; + XPV bs_pv; + int bs_iv_overflows; +}; + +int bl_getc(struct byteloader_fdata *); +int bl_read(struct byteloader_fdata *, char *, size_t, size_t); +extern void byterun(pTHXo_ struct byteloader_state *); + enum { INSN_RET, /* 0 */ INSN_LDSV, /* 1 */ INSN_LDOP, /* 2 */ INSN_STSV, /* 3 */ INSN_STOP, /* 4 */ - INSN_LDSPECSV, /* 5 */ - INSN_NEWSV, /* 6 */ - INSN_NEWOP, /* 7 */ - INSN_NEWOPN, /* 8 */ - INSN_NEWPV, /* 9 */ + INSN_STPV, /* 5 */ + INSN_LDSPECSV, /* 6 */ + INSN_NEWSV, /* 7 */ + INSN_NEWOP, /* 8 */ + INSN_NEWOPN, /* 9 */ INSN_NOP, /* 10 */ - INSN_PV_CUR, /* 11 */ - INSN_PV_FREE, /* 12 */ - INSN_SV_UPGRADE, /* 13 */ - INSN_SV_REFCNT, /* 14 */ - INSN_SV_REFCNT_ADD, /* 15 */ - INSN_SV_FLAGS, /* 16 */ - INSN_XRV, /* 17 */ - INSN_XPV, /* 18 */ - INSN_XIV32, /* 19 */ - INSN_XIV64, /* 20 */ - INSN_XNV, /* 21 */ - INSN_XLV_TARGOFF, /* 22 */ - INSN_XLV_TARGLEN, /* 23 */ - INSN_XLV_TARG, /* 24 */ - INSN_XLV_TYPE, /* 25 */ - INSN_XBM_USEFUL, /* 26 */ - INSN_XBM_PREVIOUS, /* 27 */ - INSN_XBM_RARE, /* 28 */ - INSN_XFM_LINES, /* 29 */ - INSN_XIO_LINES, /* 30 */ - INSN_XIO_PAGE, /* 31 */ - INSN_XIO_PAGE_LEN, /* 32 */ - INSN_XIO_LINES_LEFT, /* 33 */ - INSN_XIO_TOP_NAME, /* 34 */ + INSN_NEWPV, /* 11 */ + INSN_PV_CUR, /* 12 */ + INSN_PV_FREE, /* 13 */ + INSN_SV_UPGRADE, /* 14 */ + INSN_SV_REFCNT, /* 15 */ + INSN_SV_REFCNT_ADD, /* 16 */ + INSN_SV_FLAGS, /* 17 */ + INSN_XRV, /* 18 */ + INSN_XPV, /* 19 */ + INSN_XIV32, /* 20 */ + INSN_XIV64, /* 21 */ + INSN_XNV, /* 22 */ + INSN_XLV_TARGOFF, /* 23 */ + INSN_XLV_TARGLEN, /* 24 */ + INSN_XLV_TARG, /* 25 */ + INSN_XLV_TYPE, /* 26 */ + INSN_XBM_USEFUL, /* 27 */ + INSN_XBM_PREVIOUS, /* 28 */ + INSN_XBM_RARE, /* 29 */ + INSN_XFM_LINES, /* 30 */ + INSN_XIO_LINES, /* 31 */ + INSN_XIO_PAGE, /* 32 */ + INSN_XIO_PAGE_LEN, /* 33 */ + INSN_XIO_LINES_LEFT, /* 34 */ INSN_COMMENT, /* 35 */ - INSN_XIO_TOP_GV, /* 36 */ - INSN_XIO_FMT_NAME, /* 37 */ - INSN_XIO_FMT_GV, /* 38 */ - INSN_XIO_BOTTOM_NAME, /* 39 */ - INSN_XIO_BOTTOM_GV, /* 40 */ - INSN_XIO_SUBPROCESS, /* 41 */ - INSN_XIO_TYPE, /* 42 */ - INSN_XIO_FLAGS, /* 43 */ - INSN_XCV_STASH, /* 44 */ - INSN_XCV_START, /* 45 */ - INSN_XCV_ROOT, /* 46 */ - INSN_XCV_GV, /* 47 */ - INSN_XCV_FILE, /* 48 */ - INSN_XCV_DEPTH, /* 49 */ - INSN_XCV_PADLIST, /* 50 */ - INSN_XCV_OUTSIDE, /* 51 */ - INSN_XCV_FLAGS, /* 52 */ - INSN_AV_EXTEND, /* 53 */ - INSN_AV_PUSH, /* 54 */ - INSN_XAV_FILL, /* 55 */ - INSN_XAV_MAX, /* 56 */ - INSN_XAV_FLAGS, /* 57 */ - INSN_XHV_RITER, /* 58 */ - INSN_XHV_NAME, /* 59 */ - INSN_HV_STORE, /* 60 */ - INSN_SV_MAGIC, /* 61 */ - INSN_MG_OBJ, /* 62 */ - INSN_MG_PRIVATE, /* 63 */ - INSN_MG_FLAGS, /* 64 */ - INSN_MG_PV, /* 65 */ - INSN_XMG_STASH, /* 66 */ - INSN_GV_FETCHPV, /* 67 */ - INSN_GV_STASHPV, /* 68 */ - INSN_GP_SV, /* 69 */ - INSN_GP_REFCNT, /* 70 */ - INSN_GP_REFCNT_ADD, /* 71 */ - INSN_GP_AV, /* 72 */ - INSN_GP_HV, /* 73 */ - INSN_GP_CV, /* 74 */ - INSN_GP_FILE, /* 75 */ - INSN_GP_IO, /* 76 */ - INSN_GP_FORM, /* 77 */ - INSN_GP_CVGEN, /* 78 */ - INSN_GP_LINE, /* 79 */ - INSN_GP_SHARE, /* 80 */ - INSN_XGV_FLAGS, /* 81 */ - INSN_OP_NEXT, /* 82 */ - INSN_OP_SIBLING, /* 83 */ - INSN_OP_PPADDR, /* 84 */ - INSN_OP_TARG, /* 85 */ - INSN_OP_TYPE, /* 86 */ - INSN_OP_SEQ, /* 87 */ - INSN_OP_FLAGS, /* 88 */ - INSN_OP_PRIVATE, /* 89 */ - INSN_OP_FIRST, /* 90 */ - INSN_OP_LAST, /* 91 */ - INSN_OP_OTHER, /* 92 */ - INSN_OP_CHILDREN, /* 93 */ + INSN_XIO_TOP_NAME, /* 36 */ + INSN_XIO_TOP_GV, /* 37 */ + INSN_XIO_FMT_NAME, /* 38 */ + INSN_XIO_FMT_GV, /* 39 */ + INSN_XIO_BOTTOM_NAME, /* 40 */ + INSN_XIO_BOTTOM_GV, /* 41 */ + INSN_XIO_SUBPROCESS, /* 42 */ + INSN_XIO_TYPE, /* 43 */ + INSN_XIO_FLAGS, /* 44 */ + INSN_XCV_STASH, /* 45 */ + INSN_XCV_START, /* 46 */ + INSN_XCV_ROOT, /* 47 */ + INSN_XCV_GV, /* 48 */ + INSN_XCV_FILE, /* 49 */ + INSN_XCV_DEPTH, /* 50 */ + INSN_XCV_PADLIST, /* 51 */ + INSN_XCV_OUTSIDE, /* 52 */ + INSN_XCV_FLAGS, /* 53 */ + INSN_AV_EXTEND, /* 54 */ + INSN_AV_PUSH, /* 55 */ + INSN_XAV_FILL, /* 56 */ + INSN_XAV_MAX, /* 57 */ + INSN_XAV_FLAGS, /* 58 */ + INSN_XHV_RITER, /* 59 */ + INSN_XHV_NAME, /* 60 */ + INSN_HV_STORE, /* 61 */ + INSN_SV_MAGIC, /* 62 */ + INSN_MG_OBJ, /* 63 */ + INSN_MG_PRIVATE, /* 64 */ + INSN_MG_FLAGS, /* 65 */ + INSN_MG_PV, /* 66 */ + INSN_XMG_STASH, /* 67 */ + INSN_GV_FETCHPV, /* 68 */ + INSN_GV_STASHPV, /* 69 */ + INSN_GP_SV, /* 70 */ + INSN_GP_REFCNT, /* 71 */ + INSN_GP_REFCNT_ADD, /* 72 */ + INSN_GP_AV, /* 73 */ + INSN_GP_HV, /* 74 */ + INSN_GP_CV, /* 75 */ + INSN_GP_FILE, /* 76 */ + INSN_GP_IO, /* 77 */ + INSN_GP_FORM, /* 78 */ + INSN_GP_CVGEN, /* 79 */ + INSN_GP_LINE, /* 80 */ + INSN_GP_SHARE, /* 81 */ + INSN_XGV_FLAGS, /* 82 */ + INSN_OP_NEXT, /* 83 */ + INSN_OP_SIBLING, /* 84 */ + INSN_OP_PPADDR, /* 85 */ + INSN_OP_TARG, /* 86 */ + INSN_OP_TYPE, /* 87 */ + INSN_OP_SEQ, /* 88 */ + INSN_OP_FLAGS, /* 89 */ + INSN_OP_PRIVATE, /* 90 */ + INSN_OP_FIRST, /* 91 */ + INSN_OP_LAST, /* 92 */ + INSN_OP_OTHER, /* 93 */ INSN_OP_PMREPLROOT, /* 94 */ INSN_OP_PMREPLROOTGV, /* 95 */ INSN_OP_PMREPLSTART, /* 96 */ @@ -134,7 +146,10 @@ enum { INSN_MAIN_START, /* 115 */ INSN_MAIN_ROOT, /* 116 */ INSN_CURPAD, /* 117 */ - MAX_INSN = 117 + INSN_PUSH_BEGIN, /* 118 */ + INSN_PUSH_INIT, /* 119 */ + INSN_PUSH_END, /* 120 */ + MAX_INSN = 120 }; enum { @@ -151,11 +166,3 @@ enum { OPt_COP /* 10 */ }; -extern void byterun(pTHXo_ struct bytestream bs); - -#define INIT_SPECIALSV_LIST STMT_START { \ - PL_specialsv_list[0] = Nullsv; \ - PL_specialsv_list[1] = &PL_sv_undef; \ - PL_specialsv_list[2] = &PL_sv_yes; \ - PL_specialsv_list[3] = &PL_sv_no; \ - } STMT_END diff --git a/contrib/perl5/ext/DB_File/Changes b/contrib/perl5/ext/DB_File/Changes index 95eb487e5659..eda270d82b52 100644 --- a/contrib/perl5/ext/DB_File/Changes +++ b/contrib/perl5/ext/DB_File/Changes @@ -291,3 +291,46 @@ to David Harris for spotting the underlying problem, contributing the updates to the documentation and writing DB_File::Lock (available on CPAN). + +1.73 31st May 2000 + + * Added support in version.c for building with threaded Perl. + + * Berkeley DB 3.1 has reenabled support for null keys. The test + harness has been updated to reflect this. + +1.74 10th December 2000 + + * A "close" call in DB_File.xs needed parenthesised to stop win32 from + thinking it was one of its macros. + + * Updated dbinfo to support Berkeley DB 3.1 file format changes. + + * DB_File.pm & the test hasness now use the warnings pragma (when + available). + + * Included Perl core patch 7703 -- size argument for hash_cb is different + for Berkeley DB 3.x + + * Included Perl core patch 7801 -- Give __getBerkeleyDBInfo the ANSI C + treatment. + + * @a = () produced the warning 'Argument "" isn't numeric in entersub' + This has been fixed. Thanks to Edward Avis for spotting this bug. + + * Added note about building under Linux. Included patches. + + * Included Perl core patch 8068 -- fix for bug 20001013.009 + When run with warnings enabled "$hash{XX} = undef " produced an + "Uninitialized value" warning. This has been fixed. + +1.75 17th December 2000 + + * Fixed perl core patch 7703 + + * Added suppport to allow DB_File to be built with Berkeley DB 3.2 -- + btree_compare, btree_prefix and hash_cb needed to be changed. + + * Updated dbinfo to support Berkeley DB 3.2 file format changes. + + diff --git a/contrib/perl5/ext/DB_File/DB_File.pm b/contrib/perl5/ext/DB_File/DB_File.pm index 00b24b90e611..c8302168f8e4 100644 --- a/contrib/perl5/ext/DB_File/DB_File.pm +++ b/contrib/perl5/ext/DB_File/DB_File.pm @@ -1,8 +1,8 @@ # DB_File.pm -- Perl 5 interface to Berkeley DB # # written by Paul Marquess (Paul.Marquess@btinternet.com) -# last modified 16th January 2000 -# version 1.72 +# last modified 17th December 2000 +# version 1.75 # # Copyright (c) 1995-2000 Paul Marquess. All rights reserved. # This program is free software; you can redistribute it and/or @@ -13,6 +13,7 @@ package DB_File::HASHINFO ; require 5.003 ; +use warnings; use strict; use Carp; require Tie::Hash; @@ -104,6 +105,7 @@ sub CLEAR { my $self = shift ; $self->NotHere("CLEAR") } package DB_File::RECNOINFO ; +use warnings; use strict ; @DB_File::RECNOINFO::ISA = qw(DB_File::HASHINFO) ; @@ -121,6 +123,7 @@ sub TIEHASH package DB_File::BTREEINFO ; +use warnings; use strict ; @DB_File::BTREEINFO::ISA = qw(DB_File::HASHINFO) ; @@ -140,6 +143,7 @@ sub TIEHASH package DB_File ; +use warnings; use strict; use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO $db_version $use_XSLoader @@ -147,7 +151,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO use Carp; -$VERSION = "1.72" ; +$VERSION = "1.75" ; #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; $DB_BTREE = new DB_File::BTREEINFO ; @@ -271,7 +275,7 @@ sub TIEARRAY sub CLEAR { my $self = shift; - my $key = "" ; + my $key = 0 ; my $value = "" ; my $status = $self->seq($key, $value, R_FIRST()); my @keys; @@ -665,6 +669,7 @@ This example shows how to create a database, add key/value pairs to the database, delete keys/value pairs and finally how to enumerate the contents of the database. + use warnings ; use strict ; use DB_File ; use vars qw( %h $k $v ) ; @@ -715,6 +720,7 @@ This script shows how to override the default sorting algorithm that BTREE uses. Instead of using the normal lexical ordering, a case insensitive compare function will be used. + use warnings ; use strict ; use DB_File ; @@ -783,6 +789,7 @@ There are some difficulties in using the tied hash interface if you want to manipulate a BTREE database with duplicate keys. Consider this code: + use warnings ; use strict ; use DB_File ; @@ -837,6 +844,7 @@ and the API in general. Here is the script above rewritten using the C API method. + use warnings ; use strict ; use DB_File ; @@ -908,6 +916,7 @@ particular value occurred in the BTREE. So assuming the database created above, we can use C like this: + use warnings ; use strict ; use DB_File ; @@ -957,6 +966,7 @@ returns 0. Otherwise the method returns a non-zero value. Assuming the database from the previous example: + use warnings ; use strict ; use DB_File ; @@ -995,6 +1005,7 @@ Otherwise the method returns a non-zero value. Again assuming the existence of the C database + use warnings ; use strict ; use DB_File ; @@ -1039,6 +1050,7 @@ the use of the R_CURSOR flag with seq: In the example script below, the C sub uses this feature to find and print the first matching key/value pair given a partial key. + use warnings ; use strict ; use DB_File ; use Fcntl ; @@ -1143,6 +1155,7 @@ Here is a simple example that uses RECNO (if you are using a version of Perl earlier than 5.004_57 this example won't work -- see L for a workaround). + use warnings ; use strict ; use DB_File ; @@ -1232,6 +1245,7 @@ Here is a more complete example that makes use of some of the methods described above. It also makes use of the API interface directly (see L). + use warnings ; use strict ; use vars qw(@h $H $file $i) ; use DB_File ; @@ -1583,6 +1597,7 @@ the database and have them removed when you read from the database. As I'm sure you have already guessed, this is a problem that DBM Filters can fix very easily. + use warnings ; use strict ; use DB_File ; @@ -1625,6 +1640,7 @@ when reading. Here is a DBM Filter that does it: + use warnings ; use strict ; use DB_File ; my %hash ; @@ -1791,6 +1807,7 @@ Here is a snippet of code that is loosely based on Tom Christiansen's I script (available from your nearest CPAN archive in F). + use warnings ; use strict ; use DB_File ; use Fcntl ; @@ -1947,6 +1964,7 @@ You will encounter this particular error message when you have the C pragma (or the full strict pragma) in your script. Consider this script: + use warnings ; use strict ; use DB_File ; use vars qw(%x) ; diff --git a/contrib/perl5/ext/DB_File/DB_File.xs b/contrib/perl5/ext/DB_File/DB_File.xs index 2b76bab72263..fa3bb336c2d2 100644 --- a/contrib/perl5/ext/DB_File/DB_File.xs +++ b/contrib/perl5/ext/DB_File/DB_File.xs @@ -3,8 +3,8 @@ DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess - last modified 16th January 2000 - version 1.72 + last modified 17 December 2000 + version 1.75 All comments/suggestions/problems are welcome @@ -82,6 +82,14 @@ Support for Berkeley DB 2/3's backward compatability mode. Rewrote push 1.72 - No change to DB_File.xs + 1.73 - No change to DB_File.xs + 1.74 - A call to open needed parenthesised to stop it clashing + with a win32 macro. + Added Perl core patches 7703 & 7801. + 1.75 - Fixed Perl core patch 7703. + Added suppport to allow DB_File to be built with + Berkeley DB 3.2 -- btree_compare, btree_prefix and hash_cb + needed to be changed. */ @@ -127,6 +135,10 @@ # include #endif +#ifdef CAN_PROTOTYPE +extern void __getBerkeleyDBInfo(void); +#endif + #ifndef pTHX # define pTHX # define pTHX_ @@ -158,6 +170,10 @@ # define BERKELEY_DB_1_OR_2 #endif +#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2) +# define AT_LEAST_DB_3_2 +#endif + /* map version 2 features & constants onto their version 1 equivalent */ #ifdef DB_Prefix_t @@ -243,6 +259,7 @@ typedef db_recno_t recno_t; #else /* db version 1.x */ +#define BERKELEY_DB_1 #define BERKELEY_DB_1_OR_2 typedef union INFO { @@ -472,6 +489,19 @@ u_int flags ; static int +#ifdef AT_LEAST_DB_3_2 + +#ifdef CAN_PROTOTYPE +btree_compare(DB * db, const DBT *key1, const DBT *key2) +#else +btree_compare(db, key1, key2) +DB * db ; +const DBT * key1 ; +const DBT * key2 ; +#endif /* CAN_PROTOTYPE */ + +#else /* Berkeley DB < 3.2 */ + #ifdef CAN_PROTOTYPE btree_compare(const DBT *key1, const DBT *key2) #else @@ -479,6 +509,9 @@ btree_compare(key1, key2) const DBT * key1 ; const DBT * key2 ; #endif + +#endif + { #ifdef dTHX dTHX; @@ -528,12 +561,27 @@ const DBT * key2 ; } static DB_Prefix_t +#ifdef AT_LEAST_DB_3_2 + +#ifdef CAN_PROTOTYPE +btree_prefix(DB * db, const DBT *key1, const DBT *key2) +#else +btree_prefix(db, key1, key2) +Db * db ; +const DBT * key1 ; +const DBT * key2 ; +#endif + +#else /* Berkeley DB < 3.2 */ + #ifdef CAN_PROTOTYPE btree_prefix(const DBT *key1, const DBT *key2) #else btree_prefix(key1, key2) const DBT * key1 ; const DBT * key2 ; +#endif + #endif { #ifdef dTHX @@ -583,13 +631,35 @@ const DBT * key2 ; return (retval) ; } + +#ifdef BERKELEY_DB_1 +# define HASH_CB_SIZE_TYPE size_t +#else +# define HASH_CB_SIZE_TYPE u_int32_t +#endif + static DB_Hash_t +#ifdef AT_LEAST_DB_3_2 + #ifdef CAN_PROTOTYPE -hash_cb(const void *data, size_t size) +hash_cb(DB * db, const void *data, u_int32_t size) +#else +hash_cb(db, data, size) +DB * db ; +const void * data ; +HASH_CB_SIZE_TYPE size ; +#endif + +#else /* Berkeley DB < 3.2 */ + +#ifdef CAN_PROTOTYPE +hash_cb(const void *data, HASH_CB_SIZE_TYPE size) #else hash_cb(data, size) const void * data ; -size_t size ; +HASH_CB_SIZE_TYPE size ; +#endif + #endif { #ifdef dTHX @@ -1265,7 +1335,7 @@ SV * sv ; Flags |= DB_TRUNCATE ; #endif - status = RETVAL->dbp->open(RETVAL->dbp, name, NULL, RETVAL->type, + status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type, Flags, mode) ; /* printf("open returned %d %s\n", status, db_strerror(status)) ; */ diff --git a/contrib/perl5/ext/DB_File/Makefile.PL b/contrib/perl5/ext/DB_File/Makefile.PL index cac6578bb308..041416029ac4 100644 --- a/contrib/perl5/ext/DB_File/Makefile.PL +++ b/contrib/perl5/ext/DB_File/Makefile.PL @@ -17,6 +17,7 @@ WriteMakefile( OBJECT => 'version$(OBJ_EXT) DB_File$(OBJ_EXT)', XSPROTOARG => '-noprototypes', DEFINE => $OS2 || "", + INC => ($^O eq "MacOS" ? "-i ::::db:include" : "") ); sub MY::postamble { diff --git a/contrib/perl5/ext/DB_File/dbinfo b/contrib/perl5/ext/DB_File/dbinfo index 701ac612b62b..5a4df15907ee 100644 --- a/contrib/perl5/ext/DB_File/dbinfo +++ b/contrib/perl5/ext/DB_File/dbinfo @@ -4,10 +4,10 @@ # a database file # # Author: Paul Marquess -# Version: 1.02 -# Date 20th August 1999 +# Version: 1.03 +# Date 17th September 2000 # -# Copyright (c) 1998 Paul Marquess. All rights reserved. +# Copyright (c) 1998-2000 Paul Marquess. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. @@ -28,7 +28,8 @@ my %Data = 4 => "Unknown", 5 => "2.0.0 -> 2.3.0", 6 => "2.3.1 -> 2.7.7", - 7 => "3.0.0 or greater", + 7 => "3.0.x", + 8 => "3.1.x or greater", } }, 0x061561 => { @@ -40,14 +41,17 @@ my %Data = 3 => "1.86", 4 => "2.0.0 -> 2.1.0", 5 => "2.2.6 -> 2.7.7", - 6 => "3.0.0 or greater", + 6 => "3.0.x", + 7 => "3.1.x or greater", } }, 0x042253 => { Type => "Queue", Versions => { - 1 => "3.0.0 or greater", + 1 => "3.0.x", + 2 => "3.1.x", + 3 => "3.2.x or greater", } }, ) ; @@ -86,7 +90,7 @@ else { die "not a Berkeley DB database file.\n" } my $type = $Data{$magic} ; -my $magic = sprintf "%06X", $magic ; +$magic = sprintf "%06X", $magic ; my $ver_string = "Unknown" ; $ver_string = $type->{Versions}{$version} diff --git a/contrib/perl5/ext/DB_File/typemap b/contrib/perl5/ext/DB_File/typemap index 41a24f4a8638..55439ee76d91 100644 --- a/contrib/perl5/ext/DB_File/typemap +++ b/contrib/perl5/ext/DB_File/typemap @@ -1,8 +1,8 @@ # typemap for Perl 5 interface to Berkeley # # written by Paul Marquess -# last modified 7th September 1999 -# version 1.71 +# last modified 10th December 2000 +# version 1.74 # #################################### DB SECTION # @@ -29,9 +29,10 @@ T_dbtkeydatum T_dbtdatum ckFilter($arg, filter_store_value, \"filter_store_value\"); DBT_clear($var) ; - $var.data = SvPV($arg, PL_na); - $var.size = (int)PL_na; - + if (SvOK($arg)) { + $var.data = SvPV($arg, PL_na); + $var.size = (int)PL_na; + } OUTPUT diff --git a/contrib/perl5/ext/DB_File/version.c b/contrib/perl5/ext/DB_File/version.c index f8c6cac9af78..6e55b2e3d18b 100644 --- a/contrib/perl5/ext/DB_File/version.c +++ b/contrib/perl5/ext/DB_File/version.c @@ -4,7 +4,7 @@ written by Paul Marquess last modified 16th January 2000 - version 1.72 + version 1.73 All comments/suggestions/problems are welcome @@ -16,6 +16,9 @@ 1.71 - Support for Berkeley DB version 3. Support for Berkeley DB 2/3's backward compatability mode. 1.72 - No change. + 1.73 - Added support for threading + 1.74 - Added Perl core patch 7801. + */ @@ -26,8 +29,15 @@ #include void +#ifdef CAN_PROTOTYPE +__getBerkeleyDBInfo(void) +#else __getBerkeleyDBInfo() +#endif { +#ifdef dTHX + dTHX; +#endif SV * version_sv = perl_get_sv("DB_File::db_version", GV_ADD|GV_ADDMULTI) ; SV * ver_sv = perl_get_sv("DB_File::db_ver", GV_ADD|GV_ADDMULTI) ; SV * compat_sv = perl_get_sv("DB_File::db_185_compat", GV_ADD|GV_ADDMULTI) ; diff --git a/contrib/perl5/ext/Data/Dumper/Dumper.pm b/contrib/perl5/ext/Data/Dumper/Dumper.pm index 93b87f9aba96..a8e59ab379d7 100644 --- a/contrib/perl5/ext/Data/Dumper/Dumper.pm +++ b/contrib/perl5/ext/Data/Dumper/Dumper.pm @@ -9,7 +9,7 @@ package Data::Dumper; -$VERSION = '2.101'; +$VERSION = '2.102'; #$| = 1; @@ -291,8 +291,7 @@ sub _dump { $s->{level}++; $ipad = $s->{xpad} x $s->{level}; - - if ($realtype eq 'SCALAR') { + if ($realtype eq 'SCALAR' || $realtype eq 'REF') { if ($realpack) { $out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}'; } @@ -685,7 +684,7 @@ the last. Returns the stringified form of the values stored in the object (preserving the order in which they were supplied to C), subject to the -configuration options below. In an array context, it returns a list +configuration options below. In a list context, it returns a list of strings corresponding to the supplied values. The second form, for convenience, simply calls the C method on its @@ -701,7 +700,7 @@ dumping subroutine references. Expects a anonymous hash of name => value pairs. Same rules apply for names as in C. If no argument is supplied, will return the "seen" list of -name => value pairs, in an array context. Otherwise, returns the object +name => value pairs, in a list context. Otherwise, returns the object itself. =item I<$OBJ>->Values(I<[ARRAYREF]>) @@ -732,7 +731,7 @@ itself. Returns the stringified form of the values in the list, subject to the configuration options below. The values will be named C<$VAR>I in the output, where I is a numeric suffix. Will return a list of strings -in an array context. +in a list context. =back diff --git a/contrib/perl5/ext/Data/Dumper/Dumper.xs b/contrib/perl5/ext/Data/Dumper/Dumper.xs index 990ea7469931..25e72b144c9d 100644 --- a/contrib/perl5/ext/Data/Dumper/Dumper.xs +++ b/contrib/perl5/ext/Data/Dumper/Dumper.xs @@ -584,8 +584,10 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, if (SvIOK(val)) { STRLEN len; - i = SvIV(val); - (void) sprintf(tmpbuf, "%"IVdf, (IV)i); + if (SvIsUV(val)) + (void) sprintf(tmpbuf, "%"UVuf, SvUV(val)); + else + (void) sprintf(tmpbuf, "%"IVdf, SvIV(val)); len = strlen(tmpbuf); sv_catpvn(retval, tmpbuf, len); } @@ -803,7 +805,7 @@ Data_Dumper_Dumpxs(href, ...) if ((svp = av_fetch(namesav, i, TRUE))) sv_setsv(name, *svp); else - SvOK_off(name); + (void)SvOK_off(name); if (SvOK(name)) { if ((SvPVX(name))[0] == '*') { diff --git a/contrib/perl5/ext/Devel/DProf/DProf.xs b/contrib/perl5/ext/Devel/DProf/DProf.xs index 31e984f929b7..aba6de99d3ed 100644 --- a/contrib/perl5/ext/Devel/DProf/DProf.xs +++ b/contrib/perl5/ext/Devel/DProf/DProf.xs @@ -3,11 +3,6 @@ #include "perl.h" #include "XSUB.h" -/* For older Perls */ -#ifndef dTHR -# define dTHR int dummy_thr -#endif /* dTHR */ - /*#define DBG_SUB 1 */ /*#define DBG_TIMER 1 */ @@ -28,6 +23,7 @@ # define HZ ((I32)CLK_TCK) # define DPROF_HZ HZ # include /* prototype for sys$gettim() */ +# include # define Times(ptr) (dprof_times(aTHX_ ptr)) #else # ifndef HZ @@ -280,10 +276,6 @@ prof_mark(pTHX_ opcode ptype) { struct tms t; clock_t realtime, rdelta, udelta, sdelta; - char *name, *pv; - char *hvname; - STRLEN len; - SV *sv; U32 id; SV *Sub = GvSV(PL_DBsub); /* name of current sub */ @@ -388,7 +380,6 @@ prof_mark(pTHX_ opcode ptype) static void test_time(pTHX_ clock_t *r, clock_t *u, clock_t *s) { - dTHR; CV *cv = perl_get_cv("Devel::DProf::NONESUCH_noxs", FALSE); int i, j, k = 0; HV *oldstash = PL_curstash; @@ -477,8 +468,6 @@ prof_record(pTHX) /* Now that we know the runtimes, fill them in at the recorded location -JH */ - clock_t r, u, s; - if (g_SAVE_STACK) { prof_dump_until(aTHX_ g_profstack_ix); } @@ -502,7 +491,7 @@ prof_record(pTHX) static void check_depth(pTHX_ void *foo) { - U32 need_depth = (U32)foo; + U32 need_depth = PTR2UV(foo); if (need_depth != g_depth) { if (need_depth > g_depth) { warn("garbled call depth when profiling"); @@ -547,6 +536,7 @@ XS(XS_DB_sub) prof_mark(aTHX_ OP_ENTERSUB); PUSHMARK(ORIGMARK); perl_call_sv(INT2PTR(SV*,SvIV(Sub)), GIMME | G_NODEBUG); + PL_curstash = oldstash; prof_mark(aTHX_ OP_LEAVESUB); g_depth--; } diff --git a/contrib/perl5/ext/Devel/Peek/Makefile.PL b/contrib/perl5/ext/Devel/Peek/Makefile.PL index 3c6dbf545d1c..f6d0cc9caa5d 100644 --- a/contrib/perl5/ext/Devel/Peek/Makefile.PL +++ b/contrib/perl5/ext/Devel/Peek/Makefile.PL @@ -2,6 +2,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => "Devel::Peek", VERSION_FROM => 'Peek.pm', + XSPROTOARG => '-noprototypes', 'dist' => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', diff --git a/contrib/perl5/ext/Devel/Peek/Peek.pm b/contrib/perl5/ext/Devel/Peek/Peek.pm index 080251bb5e87..08501728c06d 100644 --- a/contrib/perl5/ext/Devel/Peek/Peek.pm +++ b/contrib/perl5/ext/Devel/Peek/Peek.pm @@ -10,7 +10,8 @@ require Exporter; use XSLoader (); @ISA = qw(Exporter); -@EXPORT = qw(Dump mstat DeadCode DumpArray DumpWithOP DumpProg); +@EXPORT = qw(Dump mstat DeadCode DumpArray DumpWithOP DumpProg + fill_mstats mstats_fillhash mstats2hash); @EXPORT_OK = qw(SvREFCNT SvREFCNT_inc SvREFCNT_dec CvGV); %EXPORT_TAGS = ('ALL' => [@EXPORT, @EXPORT_OK]); @@ -58,16 +59,76 @@ C. Devel::Peek also supplies C, C, and C which can query, increment, and decrement reference counts on SVs. This document will take a passive, and safe, approach to data debugging and for that it will describe only the C -function. For format of output of mstats() see -L>. +function. Function C allows dumping of multiple values (useful when you -need to analize returns of functions). +need to analyze returns of functions). The global variable $Devel::Peek::pv_limit can be set to limit the number of character printed in various string values. Setting it to 0 means no limit. +=head2 Memory footprint debugging + +When perl is compiled with support for memory footprint debugging +(default with Perl's malloc()), Devel::Peek provides an access to this API. + +Use mstat() function to emit a memory state statistic to the terminal. +For more information on the format of output of mstat() see +L>. + +Three additional functions allow access to this statistic from Perl. +First, use C to get the information contained +in the output of mstat() into %hash. The field of this hash are + + minbucket nbuckets sbrk_good sbrk_slack sbrked_remains sbrks start_slack + topbucket topbucket_ev topbucket_odd total total_chain total_sbrk totfree + +Two additional fields C, C contain array references which +provide per-bucket count of free and used chunks. Two other fields +C, C contain array references which provide +the information about the allocated size and usable size of chunks in +each bucket. Again, see L> +for details. + +Keep in mind that only the first several "odd-numbered" buckets are +used, so the information on size of the "odd-numbered" buckets which are +not used is probably meaningless. + +The information in + + mem_size available_size minbucket nbuckets + +is the property of a particular build of perl, and does not depend on +the current process. If you do not provide the optional argument to +the functions mstats_fillhash(), fill_mstats(), mstats2hash(), then +the information in fields C, C is not +updated. + +C is a much cheaper call (both speedwise and +memory-wise) which collects the statistic into $buf in +machine-readable form. At a later moment you may need to call +C to use this information to fill %hash. + +All three APIs C, C, and +C are designed to allocate no memory if used +I on the same $buf and/or %hash. + +So, if you want to collect memory info in a cycle, you may call + + $#buf = 999; + fill_mstats($_) for @buf; + mstats_fillhash(%report, 1); # Static info too + + foreach (@buf) { + # Do something... + fill_mstats $_; # Collect statistic + } + foreach (@buf) { + mstats2hash($_, %report); # Preserve static info + # Do something with %report + } + =head1 EXAMPLES The following examples don't attempt to show everything as that would be a @@ -403,8 +464,9 @@ it has no prototype (C field is missing). =head1 EXPORTS C, C, C, C, C and -C by default. Additionally available C, -C and C. +C, C, C, C by +default. Additionally available C, C and +C. =head1 BUGS diff --git a/contrib/perl5/ext/Devel/Peek/Peek.xs b/contrib/perl5/ext/Devel/Peek/Peek.xs index 9837e9ceb216..1e481492b5d9 100644 --- a/contrib/perl5/ext/Devel/Peek/Peek.xs +++ b/contrib/perl5/ext/Devel/Peek/Peek.xs @@ -82,8 +82,6 @@ DeadCode(pTHX) } } else if (SvTYPE(pad[j]) >= SVt_PV && SvLEN(pad[j])) { - int db_len = SvLEN(pad[j]); - SV *db_sv = pad[j]; levels++; levelm += SvLEN(pad[j])/SvREFCNT(pad[j]); /* Dump(pad[j],4); */ @@ -125,6 +123,183 @@ DeadCode(pTHX) PerlIO_printf(Perl_debug_log, "%s: perl not compiled with DEBUGGING_MSTATS\n",str); #endif +#if defined(PERL_DEBUGGING_MSTATS) || defined(DEBUGGING_MSTATS) \ + || (defined(MYMALLOC) && !defined(PLAIN_MALLOC)) + +/* Very coarse overestimate, 2-per-power-of-2, one more to determine NBUCKETS. */ +# define _NBUCKETS (2*8*IVSIZE+1) + +struct mstats_buffer +{ + perl_mstats_t buffer; + UV buf[_NBUCKETS*4]; +}; + +void +_fill_mstats(struct mstats_buffer *b, int level) +{ + dTHX; + b->buffer.nfree = b->buf; + b->buffer.ntotal = b->buf + _NBUCKETS; + b->buffer.bucket_mem_size = b->buf + 2*_NBUCKETS; + b->buffer.bucket_available_size = b->buf + 3*_NBUCKETS; + Zero(b->buf, (level ? 4*_NBUCKETS: 2*_NBUCKETS), unsigned long); + get_mstats(&(b->buffer), _NBUCKETS, level); +} + +void +fill_mstats(SV *sv, int level) +{ + dTHX; + int nbuckets; + struct mstats_buffer buf; + + if (SvREADONLY(sv)) + croak("Cannot modify a readonly value"); + SvGROW(sv, sizeof(struct mstats_buffer)+1); + _fill_mstats((struct mstats_buffer*)SvPVX(sv),level); + SvCUR_set(sv, sizeof(struct mstats_buffer)); + *SvEND(sv) = '\0'; + SvPOK_only(sv); +} + +void +_mstats_to_hv(HV *hv, struct mstats_buffer *b, int level) +{ + dTHX; + SV **svp; + int type; + + svp = hv_fetch(hv, "topbucket", 9, 1); + sv_setiv(*svp, b->buffer.topbucket); + + svp = hv_fetch(hv, "topbucket_ev", 12, 1); + sv_setiv(*svp, b->buffer.topbucket_ev); + + svp = hv_fetch(hv, "topbucket_odd", 13, 1); + sv_setiv(*svp, b->buffer.topbucket_odd); + + svp = hv_fetch(hv, "totfree", 7, 1); + sv_setiv(*svp, b->buffer.totfree); + + svp = hv_fetch(hv, "total", 5, 1); + sv_setiv(*svp, b->buffer.total); + + svp = hv_fetch(hv, "total_chain", 11, 1); + sv_setiv(*svp, b->buffer.total_chain); + + svp = hv_fetch(hv, "total_sbrk", 10, 1); + sv_setiv(*svp, b->buffer.total_sbrk); + + svp = hv_fetch(hv, "sbrks", 5, 1); + sv_setiv(*svp, b->buffer.sbrks); + + svp = hv_fetch(hv, "sbrk_good", 9, 1); + sv_setiv(*svp, b->buffer.sbrk_good); + + svp = hv_fetch(hv, "sbrk_slack", 10, 1); + sv_setiv(*svp, b->buffer.sbrk_slack); + + svp = hv_fetch(hv, "start_slack", 11, 1); + sv_setiv(*svp, b->buffer.start_slack); + + svp = hv_fetch(hv, "sbrked_remains", 14, 1); + sv_setiv(*svp, b->buffer.sbrked_remains); + + svp = hv_fetch(hv, "minbucket", 9, 1); + sv_setiv(*svp, b->buffer.minbucket); + + svp = hv_fetch(hv, "nbuckets", 8, 1); + sv_setiv(*svp, b->buffer.nbuckets); + + if (_NBUCKETS < b->buffer.nbuckets) + warn("FIXME: internal mstats buffer too short"); + + for (type = 0; type < (level ? 4 : 2); type++) { + UV *p, *p1; + AV *av; + int i; + static const char *types[4] = { + "free", "used", "mem_size", "available_size" + }; + + svp = hv_fetch(hv, types[type], strlen(types[type]), 1); + + if (SvOK(*svp) && !(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV)) + croak("Unexpected value for the key '%s' in the mstats hash", types[type]); + if (!SvOK(*svp)) { + av = newAV(); + SvUPGRADE(*svp, SVt_RV); + SvRV(*svp) = (SV*)av; + SvROK_on(*svp); + } else + av = (AV*)SvRV(*svp); + + av_extend(av, b->buffer.nbuckets - 1); + /* XXXX What is the official way to reduce the size of the array? */ + switch (type) { + case 0: + p = b->buffer.nfree; + break; + case 1: + p = b->buffer.ntotal; + p1 = b->buffer.nfree; + break; + case 2: + p = b->buffer.bucket_mem_size; + break; + case 3: + p = b->buffer.bucket_available_size; + break; + } + for (i = 0; i < b->buffer.nbuckets; i++) { + svp = av_fetch(av, i, 1); + if (type == 1) + sv_setiv(*svp, p[i]-p1[i]); + else + sv_setuv(*svp, p[i]); + } + } +} +void +mstats_fillhash(SV *sv, int level) +{ + struct mstats_buffer buf; + + if (!(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV)) + croak("Not a hash reference"); + _fill_mstats(&buf, level); + _mstats_to_hv((HV *)SvRV(sv), &buf, level); +} +void +mstats2hash(SV *sv, SV *rv, int level) +{ + if (!(SvROK(rv) && SvTYPE(SvRV(rv)) == SVt_PVHV)) + croak("Not a hash reference"); + if (!SvPOK(sv)) + croak("Undefined value when expecting mstats buffer"); + if (SvCUR(sv) != sizeof(struct mstats_buffer)) + croak("Wrong size for a value with a mstats buffer"); + _mstats_to_hv((HV *)SvRV(rv), (struct mstats_buffer*)SvPVX(sv), level); +} +#else /* !( defined(PERL_DEBUGGING_MSTATS) || defined(DEBUGGING_MSTATS) \ ) */ +void +fill_mstats(SV *sv, int level) +{ + croak("Cannot report mstats without Perl malloc"); +} +void +mstats_fillhash(SV *sv, int level) +{ + croak("Cannot report mstats without Perl malloc"); +} +void +mstats2hash(SV *sv, SV *rv, int level) +{ + croak("Cannot report mstats without Perl malloc"); +} +#endif /* defined(PERL_DEBUGGING_MSTATS) || defined(DEBUGGING_MSTATS)... */ + #define _CvGV(cv) \ (SvROK(cv) && (SvTYPE(SvRV(cv))==SVt_PVCV) \ ? SvREFCNT_inc(CvGV((CV*)SvRV(cv))) : &PL_sv_undef) @@ -135,6 +310,17 @@ void mstat(str="Devel::Peek::mstat: ") char *str +void +fill_mstats(SV *sv, int level = 0) + +void +mstats_fillhash(SV *sv, int level = 0) + PROTOTYPE: \%;$ + +void +mstats2hash(SV *sv, SV *rv, int level = 0) + PROTOTYPE: $\%;$ + void Dump(sv,lim=4) SV * sv @@ -173,7 +359,7 @@ void DumpProg() PPCODE: { - warn("dumpindent is %d", PL_dumpindent); + warn("dumpindent is %d", (int)PL_dumpindent); if (PL_main_root) op_dump(PL_main_root); } @@ -195,7 +381,7 @@ PPCODE: # PPCODE needed since by default it is void -SV * +void SvREFCNT_dec(sv) SV * sv PPCODE: diff --git a/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL b/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL index e0eb604c73ae..266c9d030f77 100644 --- a/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL +++ b/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL @@ -1,4 +1,3 @@ - use Config; sub to_string { @@ -12,7 +11,7 @@ unlink "DynaLoader.pm" if -f "DynaLoader.pm"; open OUT, ">DynaLoader.pm" or die $!; print OUT <<'EOT'; -# Generated from DynaLoader.pm.PL (resolved %Config::Config values) +# Generated from DynaLoader.pm.PL package DynaLoader; @@ -21,18 +20,22 @@ package DynaLoader; # feast like to keep their secret; for wonder makes the words of # praise louder.' -# (Quote from Tolkien sugested by Anno Siegel.) +# (Quote from Tolkien suggested by Anno Siegel.) # # See pod text at end of file for documentation. # See also ext/DynaLoader/README in source tree for other information. # # Tim.Bunce@ig.co.uk, August 1994 -$VERSION = "1.04"; # avoid typo warning +use vars qw($VERSION *AUTOLOAD); + +$VERSION = 1.04; # avoid typo warning require AutoLoader; *AUTOLOAD = \&AutoLoader::AUTOLOAD; +use Config; + # The following require can't be removed during maintenance # releases, sadly, because of the risk of buggy code that does # require Carp; Carp::croak "..."; without brackets dying @@ -40,7 +43,6 @@ require AutoLoader; # We'll let those bugs get found on the development track. require Carp if $] < 5.00450; - # enable debug/trace messages from DynaLoader perl code $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; @@ -71,52 +73,116 @@ print OUT <<'EOT'; # (VMS support by Charles Bailey ) # See dl_expandspec() for more details. Should be harmless but # inefficient to define on systems that don't need it. -$do_expand = $Is_VMS = $^O eq 'VMS'; +$Is_VMS = $^O eq 'VMS'; +$do_expand = $Is_VMS; $Is_MacOS = $^O eq 'MacOS'; @dl_require_symbols = (); # names of symbols we need @dl_resolve_using = (); # names of files to link with @dl_library_path = (); # path to look for files -#@dl_librefs = (); # things we have loaded -#@dl_modules = (); # Modules we have loaded +@dl_librefs = (); # things we have loaded +@dl_modules = (); # Modules we have loaded # This is a fix to support DLD's unfortunate desire to relink -lc @dl_resolve_using = dl_findfile('-lc') if $dlsrc eq "dl_dld.xs"; -# Initialise @dl_library_path with the 'standard' library path -# for this platform as determined by Configure - -# push(@dl_library_path, split(' ', $Config::Config{'libpth'}); EOT -print OUT "push(\@dl_library_path, split(' ', ", - to_string($Config::Config{'libpth'}), "));\n"; +my $cfg_dl_library_path = <<'EOT'; +push(@dl_library_path, split(' ', $Config::Config{libpth})); +EOT -print OUT <<'EOT'; - -# Add to @dl_library_path any extra directories we can gather -# from environment variables. -if ($Is_MacOS) { - push(@dl_library_path, split(/,/, $ENV{LD_LIBRARY_PATH})) - if exists $ENV{LD_LIBRARY_PATH}; -} else { - push(@dl_library_path, split(/:/, $ENV{$Config::Config{ldlibpthname}})) - if exists $Config::Config{ldlibpthname} && - $Config::Config{ldlibpthname} ne '' && - exists $ENV{$Config::Config{ldlibpthname}} ;; - push(@dl_library_path, split(/:/, $ENV{$Config::Config{ldlibpthname}})) - if exists $Config::Config{ldlibpthname} && - $Config::Config{ldlibpthname} ne '' && - exists $ENV{$Config::Config{ldlibpthname}} ;; -# E.g. HP-UX supports both its native SHLIB_PATH *and* LD_LIBRARY_PATH. -push(@dl_library_path, split(/:/, $ENV{LD_LIBRARY_PATH})) - if exists $ENV{LD_LIBRARY_PATH}; +sub dquoted_comma_list { + join(", ", map {qq("$_")} @_); } -# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. -boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && - !defined(&dl_load_file); +if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) { + eval $cfg_dl_library_path; + if (!$ENV{PERL_BUILD_EXPAND_ENV_VARS}) { + my $dl_library_path = dquoted_comma_list(@dl_library_path); + print OUT <\]]/ && -d $_) { push(@dirs, $_); next; } diff --git a/contrib/perl5/ext/DynaLoader/XSLoader_pm.PL b/contrib/perl5/ext/DynaLoader/XSLoader_pm.PL index 8cdfd634255e..7657410d46c3 100644 --- a/contrib/perl5/ext/DynaLoader/XSLoader_pm.PL +++ b/contrib/perl5/ext/DynaLoader/XSLoader_pm.PL @@ -37,10 +37,12 @@ print OUT ' my $dl_dlext = ', to_string($Config::Config{'dlext'}), ";\n" ; print OUT <<'EOT'; -# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. package DynaLoader; + +# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. +# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && - !defined(&dl_load_file); + !defined(&dl_error); package XSLoader; 1; # End of main code diff --git a/contrib/perl5/ext/DynaLoader/dl_aix.xs b/contrib/perl5/ext/DynaLoader/dl_aix.xs index 35242ed652da..e29c0f85f76f 100644 --- a/contrib/perl5/ext/DynaLoader/dl_aix.xs +++ b/contrib/perl5/ext/DynaLoader/dl_aix.xs @@ -11,6 +11,8 @@ * on statup... It can probably be trimmed more. */ +#define PERLIO_NOT_STDIO 0 + /* * @(#)dlfcn.c 1.5 revision of 93/02/14 20:14:17 * This is an unpublished work copyright (c) 1992 Helios Software GmbH @@ -36,6 +38,8 @@ #include #include #include +#undef FREAD +#undef FWRITE #include #ifdef USE_64_BIT_ALL @@ -58,13 +62,18 @@ /* Older AIX C compilers cannot deal with C++ double-slash comments in the ibmcxx and/or xlC includes. Since we only need a single file, be more fine-grained about what's included */ + #ifdef USE_libC /* The define comes, when it comes, from hints/aix.pl. */ # define LOAD loadAndInit # define UNLOAD terminateAndUnload -# if defined(USE_xlC_load_h) -# include "/usr/lpp/xlC/include/load.h" +# if defined(USE_vacpp_load_h) +# include "/usr/vacpp/include/load.h" # elif defined(USE_ibmcxx_load_h) # include "/usr/ibmcxx/include/load.h" +# elif defined(USE_xlC_load_h) +# include "/usr/lpp/xlC/include/load.h" +# elif defined(USE_load_h) +# include "/usr/include/load.h" # endif #else # define LOAD load @@ -85,12 +94,6 @@ # define FREAD(p,s,n,ldptr) fread(p,s,n,IOPTR(ldptr)) #endif -/* If using PerlIO, redefine these macros from */ -#ifdef USE_PERLIO -#define FSEEK(ldptr,o,p) PerlIO_seek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr)+o):o,p) -#define FREAD(p,s,n,ldptr) PerlIO_read(IOPTR(ldptr),p,s*n) -#endif - /* * We simulate dlopen() et al. through a call to load. Because AIX has * no call to find an exported symbol we read the loader section of the @@ -116,8 +119,8 @@ typedef struct Module { } Module, *ModulePtr; /* - * We keep a list of all loaded modules to be able to call the fini - * handlers at atexit() time. + * We keep a list of all loaded modules to be able to reference count + * duplicate dlopen's. */ static ModulePtr modList; /* XXX threaded */ @@ -130,7 +133,7 @@ static int errvalid; /* XXX threaded */ static void caterr(char *); static int readExports(ModulePtr); -static void terminate(void); +static void *findMain(void); static char *strerror_failed = "(strerror failed)"; static char *strerror_r_failed = "(strerror_r failed)"; @@ -197,15 +200,15 @@ void *dlopen(char *path, int mode) { dTHX; register ModulePtr mp; - static int inited; /* XXX threaded */ + static void *mainModule; /* XXX threaded */ /* * Upon the first call register a terminate handler that will * close all libraries. */ - if (!inited) { - inited++; - atexit(terminate); + if (mainModule == NULL) { + if ((mainModule = findMain()) == NULL) + return NULL; } /* * Scan the list of modules if have the module already loaded. @@ -273,9 +276,13 @@ void *dlopen(char *path, int mode) /* * Assume anonymous exports come from the module this dlopen * is linked into, that holds true as long as dlopen and all - * of the perl core are in the same shared object. + * of the perl core are in the same shared object. Also bind + * against the main part, in the case a perl is not the main + * part, e.g mod_perl as DSO in Apache so perl modules can + * also reference Apache symbols. */ - if (loadbind(0, (void *)dlopen, mp->entry) == -1) { + if (loadbind(0, (void *)dlopen, mp->entry) == -1 || + loadbind(0, mainModule, mp->entry)) { int saverrno = errno; dlclose(mp); @@ -303,7 +310,7 @@ static void caterr(char *s) p++; switch(atoi(s)) { case L_ERROR_TOOMANY: - strcat(errbuf, "to many errors"); + strcat(errbuf, "too many errors"); break; case L_ERROR_NOLIB: strcat(errbuf, "can't load library"); @@ -393,12 +400,6 @@ int dlclose(void *handle) return result; } -static void terminate(void) -{ - while (modList) - dlclose(modList); -} - /* Added by Wayne Scott * This is needed because the ldopen system call calls * calloc to allocated a block of date. The ldclose call calls free. @@ -530,11 +531,7 @@ static int readExports(ModulePtr mp) } /* This first case is a hack, since it assumes that the 3rd parameter to FREAD is 1. See the redefinition of FREAD above to see how this works. */ -#ifdef USE_PERLIO - if (FREAD(ldbuf, sh.s_size, 1, ldp) != sh.s_size) { -#else if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) { -#endif errvalid++; strcpy(errbuf, "readExports: cannot read loader section"); safefree(ldbuf); @@ -590,6 +587,52 @@ static int readExports(ModulePtr mp) return 0; } +/* + * Find the main modules entry point. This is used as export pointer + * for loadbind() to be able to resolve references to the main part. + */ +static void * findMain(void) +{ + struct ld_info *lp; + char *buf; + int size = 4*1024; + int i; + void *ret; + + if ((buf = safemalloc(size)) == NULL) { + errvalid++; + strcpy(errbuf, "findMain: "); + strerrorcat(errbuf, errno); + return NULL; + } + while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) { + safefree(buf); + size += 4*1024; + if ((buf = safemalloc(size)) == NULL) { + errvalid++; + strcpy(errbuf, "findMain: "); + strerrorcat(errbuf, errno); + return NULL; + } + } + if (i == -1) { + errvalid++; + strcpy(errbuf, "findMain: "); + strerrorcat(errbuf, errno); + safefree(buf); + return NULL; + } + /* + * The first entry is the main module. The entry point + * returned by load() does actually point to the data + * segment origin. + */ + lp = (struct ld_info *)buf; + ret = lp->ldinfo_dataorg; + safefree(buf); + return ret; +} + /* dl_dlopen.xs * * Platform: SunOS/Solaris, possibly others which use dlopen. @@ -642,6 +685,17 @@ dl_load_file(filename, flags=0) else sv_setiv( ST(0), PTR2IV(RETVAL) ); +int +dl_unload_file(libref) + void * libref + CODE: + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", libref)); + RETVAL = (dlclose(libref) == 0 ? 1 : 0); + if (!RETVAL) + SaveError(aTHX_ "%s", dlerror()) ; + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL)); + OUTPUT: + RETVAL void * dl_find_symbol(libhandle, symbolname) diff --git a/contrib/perl5/ext/DynaLoader/dl_dlopen.xs b/contrib/perl5/ext/DynaLoader/dl_dlopen.xs index 8e4936d128d9..e1b2a8241082 100644 --- a/contrib/perl5/ext/DynaLoader/dl_dlopen.xs +++ b/contrib/perl5/ext/DynaLoader/dl_dlopen.xs @@ -112,7 +112,7 @@ SaveError("%s",dlerror()) ; Note that SaveError() takes a printf format string. Use a "%s" as - the first parameter if the error may contain and % characters. + the first parameter if the error may contain any % characters. */ @@ -198,7 +198,7 @@ int dl_unload_file(libref) void * libref CODE: - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", libref)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref))); RETVAL = (dlclose(libref) == 0 ? 1 : 0); if (!RETVAL) SaveError(aTHX_ "%s", dlerror()) ; diff --git a/contrib/perl5/ext/DynaLoader/hints/aix.pl b/contrib/perl5/ext/DynaLoader/hints/aix.pl index 7dde941b43d6..d4231ccb3ef8 100644 --- a/contrib/perl5/ext/DynaLoader/hints/aix.pl +++ b/contrib/perl5/ext/DynaLoader/hints/aix.pl @@ -2,9 +2,13 @@ use Config; if ($Config{libs} =~ /-lC/ && -f '/lib/libC.a') { $self->{CCFLAGS} = $Config{ccflags} . ' -DUSE_libC'; - if (-f '/usr/ibmcxx/include/load.h') { + if (-f '/usr/vacpp/include/load.h') { + $self->{CCFLAGS} .= ' -DUSE_vacpp_load_h'; + } elsif (-f '/usr/ibmcxx/include/load.h') { $self->{CCFLAGS} .= ' -DUSE_ibmcxx_load_h'; } elsif (-f '/usr/lpp/xlC/include/load.h') { $self->{CCFLAGS} .= ' -DUSE_xlC_load_h'; + } elsif (-f '/usr/include/load.h') { + $self->{CCFLAGS} .= ' -DUSE_load_h'; } } diff --git a/contrib/perl5/ext/Errno/ChangeLog b/contrib/perl5/ext/Errno/ChangeLog index 2bfa003d96a4..dd94b37bafb0 100644 --- a/contrib/perl5/ext/Errno/ChangeLog +++ b/contrib/perl5/ext/Errno/ChangeLog @@ -1,3 +1,8 @@ +Change 171 on 2000-09-12 by (Calle Dybedahl) + + - Fixed filename-extracting regexp to allow whitespace between + "#" and "line", which the cpp on Unicos 9 produces. + Change 170 on 1998/07/05 by (Graham Barr) Fixed three problems reported by Hans Mulder for NeXT diff --git a/contrib/perl5/ext/Errno/Errno_pm.PL b/contrib/perl5/ext/Errno/Errno_pm.PL index df68dc3bda60..3f2f3e04266a 100644 --- a/contrib/perl5/ext/Errno/Errno_pm.PL +++ b/contrib/perl5/ext/Errno/Errno_pm.PL @@ -29,6 +29,14 @@ sub process_file { warn "Cannot open '$file'"; return; } + } elsif ($Config{gccversion} ne '') { + # With the -dM option, gcc outputs every #define it finds + my $ccopts = "-E -dM "; + $ccopts .= "-traditional-cpp " if $^O eq 'darwin'; + unless(open(FH,"$Config{cc} $ccopts $file |")) { + warn "Cannot open '$file'"; + return; + } } else { unless(open(FH,"< $file")) { # This file could be a temporary file created by cppstdin @@ -37,11 +45,19 @@ sub process_file { return; } } - while() { - $err{$1} = 1 - if /^\s*#\s*define\s+(E\w+)\s+/; - } - close(FH); + + if ($^O eq 'MacOS') { + while() { + $err{$1} = $2 + if /^\s*#\s*define\s+(E\w+)\s+(\d+)/; + } + } else { + while() { + $err{$1} = 1 + if /^\s*#\s*define\s+(E\w+)\s+/; + } + } + close(FH); } my $cppstdin; @@ -79,6 +95,18 @@ sub get_files { } elsif ($^O eq 'vmesa') { # OS/390 C compiler doesn't generate #file or #line directives $file{'../../vmesa/errno.h'} = 1; + } elsif ($Config{archname} eq 'epoc') { + # Watch out for cross compiling for EPOC (usually done on linux) + $file{'/usr/local/epoc/include/libc/sys/errno.h'} = 1; + } elsif ($^O eq 'linux') { + # Some Linuxes have weird errno.hs which generate + # no #file or #line directives + $file{'/usr/include/errno.h'} = 1; + } elsif ($^O eq 'MacOS') { + # note that we are only getting the GUSI errno's here ... + # we might miss out on compiler-specific ones + $file{"$ENV{GUSI}include:sys:errno.h"} = 1; + } else { open(CPPI,"> errno.c") or die "Cannot open errno.c"; @@ -102,7 +130,7 @@ sub get_files { $pat = '^/\*\s+(.+)\s+\d+\s*:\s+\*/'; } else { - $pat = '^#(?:line)?\s*\d+\s+"([^"]+)"'; + $pat = '^#\s*(?:line)?\s*\d+\s+"([^"]+)"'; } while() { if ($^O eq 'os2' or $^O eq 'MSWin32') { @@ -141,31 +169,33 @@ sub write_errno_pm { close(CPPI); + unless ($^O eq 'MacOS') { # trust what we have # invoke CPP and read the output - if ($^O eq 'VMS') { - my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}"; - $cpp =~ s/sys\$input//i; - open(CPPO,"$cpp errno.c |") or - die "Cannot exec $Config{cppstdin}"; - } elsif ($^O eq 'MSWin32') { - open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or - die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'"; - } else { - my $cpp = default_cpp(); - open(CPPO,"$cpp < errno.c |") - or die "Cannot exec $cpp"; - } + if ($^O eq 'VMS') { + my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}"; + $cpp =~ s/sys\$input//i; + open(CPPO,"$cpp errno.c |") or + die "Cannot exec $Config{cppstdin}"; + } elsif ($^O eq 'MSWin32') { + open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or + die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'"; + } else { + my $cpp = default_cpp(); + open(CPPO,"$cpp < errno.c |") + or die "Cannot exec $cpp"; + } - %err = (); + %err = (); - while() { - my($name,$expr); - next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/; - next if $name eq $expr; - $err{$name} = eval $expr; + while() { + my($name,$expr); + next unless ($name, $expr) = /"(.*?)"\s*\[\s*\[\s*(.*?)\s*\]\s*\]/; + next if $name eq $expr; + $err{$name} = eval $expr; + } + close(CPPO); } - close(CPPO); # Write Errno.pm diff --git a/contrib/perl5/ext/Fcntl/Fcntl.xs b/contrib/perl5/ext/Fcntl/Fcntl.xs index b597e03c1a1b..51851bb6746b 100644 --- a/contrib/perl5/ext/Fcntl/Fcntl.xs +++ b/contrib/perl5/ext/Fcntl/Fcntl.xs @@ -33,13 +33,6 @@ --AD October 16, 1995 */ -static int -not_here(char *s) -{ - croak("%s not implemented on this architecture", s); - return -1; -} - static double constant(char *name, int arg) { diff --git a/contrib/perl5/ext/File/Glob/Changes b/contrib/perl5/ext/File/Glob/Changes index e246c6d6840f..f46ec704e9ad 100644 --- a/contrib/perl5/ext/File/Glob/Changes +++ b/contrib/perl5/ext/File/Glob/Changes @@ -45,3 +45,5 @@ Revision history for Perl extension File::Glob - Add support for either \ or / as separators on DOSISH systems - Limit effect of \ as a quoting operator on DOSISH systems to when it precedes one of []{}-~\ (to minimise backslashitis). +0.992 Tue Mar 20 09:25:48 2001 + - Add alphabetic sorting for csh compatibility (GLOB_ALPHASORT) diff --git a/contrib/perl5/ext/File/Glob/Glob.pm b/contrib/perl5/ext/File/Glob/Glob.pm index 4b7e54b9e3ea..20b26f9661f2 100644 --- a/contrib/perl5/ext/File/Glob/Glob.pm +++ b/contrib/perl5/ext/File/Glob/Glob.pm @@ -11,10 +11,15 @@ require AutoLoader; @ISA = qw(Exporter AutoLoader); +# NOTE: The glob() export is only here for compatibility with 5.6.0. +# csh_glob() should not be used directly, unless you know what you're doing. + @EXPORT_OK = qw( csh_glob + bsd_glob glob GLOB_ABEND + GLOB_ALPHASORT GLOB_ALTDIRFUNC GLOB_BRACE GLOB_CSH @@ -33,6 +38,7 @@ require AutoLoader; %EXPORT_TAGS = ( 'glob' => [ qw( GLOB_ABEND + GLOB_ALPHASORT GLOB_ALTDIRFUNC GLOB_BRACE GLOB_CSH @@ -47,6 +53,7 @@ require AutoLoader; GLOB_QUOTE GLOB_TILDE glob + bsd_glob ) ], ); @@ -99,7 +106,13 @@ sub GLOB_ERROR { return constant('GLOB_ERROR', 0); } -sub GLOB_CSH () { GLOB_BRACE() | GLOB_NOMAGIC() | GLOB_QUOTE() | GLOB_TILDE() } +sub GLOB_CSH () { + GLOB_BRACE() + | GLOB_NOMAGIC() + | GLOB_QUOTE() + | GLOB_TILDE() + | GLOB_ALPHASORT() +} $DEFAULT_FLAGS = GLOB_CSH(); if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) { @@ -108,12 +121,18 @@ if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) { # Autoload methods go after =cut, and are processed by the autosplit program. -sub glob { +sub bsd_glob { my ($pat,$flags) = @_; $flags = $DEFAULT_FLAGS if @_ < 2; return doglob($pat,$flags); } +# File::Glob::glob() is deprecated because its prototype is different from +# CORE::glob() (use bsd_glob() instead) +sub glob { + goto &bsd_glob; +} + ## borrowed heavily from gsar's File::DosGlob my %iter; my %entries; @@ -127,6 +146,9 @@ sub csh_glob { $pat = $_ unless defined $pat; # extract patterns + $pat =~ s/^\s+//; # Protect against empty elements in + $pat =~ s/\s+$//; # things like < *.c> and <*.c >. + # These alone shouldn't trigger ParseWords. if ($pat =~ /\s/) { # XXX this is needed for compatibility with the csh # implementation in Perl. Need to support a flag @@ -177,13 +199,13 @@ File::Glob - Perl extension for BSD glob routine =head1 SYNOPSIS use File::Glob ':glob'; - @list = glob('*.[ch]'); - $homedir = glob('~gnat', GLOB_TILDE | GLOB_ERR); + @list = bsd_glob('*.[ch]'); + $homedir = bsd_glob('~gnat', GLOB_TILDE | GLOB_ERR); if (GLOB_ERROR) { # an error occurred reading $homedir } - ## override the core glob (core glob() does this automatically + ## override the core glob (CORE::glob() does this automatically ## by default anyway, since v5.6.0) use File::Glob ':globally'; my @sources = <*.{c,h,y}> @@ -198,19 +220,27 @@ File::Glob - Perl extension for BSD glob routine =head1 DESCRIPTION -File::Glob implements the FreeBSD glob(3) routine, which is a superset -of the POSIX glob() (described in IEEE Std 1003.2 "POSIX.2"). The -glob() routine takes a mandatory C argument, and an optional +File::Glob::bsd_glob() implements the FreeBSD glob(3) routine, which is +a superset of the POSIX glob() (described in IEEE Std 1003.2 "POSIX.2"). +bsd_glob() takes a mandatory C argument, and an optional C argument, and returns a list of filenames matching the pattern, with interpretation of the pattern modified by the C -variable. The POSIX defined flags are: +variable. + +Since v5.6.0, Perl's CORE::glob() is implemented in terms of bsd_glob(). +Note that they don't share the same prototype--CORE::glob() only accepts +a single argument. Due to historical reasons, CORE::glob() will also +split its argument on whitespace, treating it as multiple patterns, +whereas bsd_glob() considers them as one pattern. + +The POSIX defined flags for bsd_glob() are: =over 4 =item C -Force glob() to return an error when it encounters a directory it -cannot open or read. Ordinarily glob() continues to find matches. +Force bsd_glob() to return an error when it encounters a directory it +cannot open or read. Ordinarily bsd_glob() continues to find matches. =item C @@ -220,18 +250,18 @@ appended. =item C By default, file names are assumed to be case sensitive; this flag -makes glob() treat case differences as not significant. +makes bsd_glob() treat case differences as not significant. =item C -If the pattern does not match any pathname, then glob() returns a list +If the pattern does not match any pathname, then bsd_glob() returns a list consisting of only the pattern. If C is set, its effect is present in the pattern returned. =item C By default, the pathnames are sorted in ascending ASCII order; this -flag prevents that sorting (speeding up glob()). +flag prevents that sorting (speeding up bsd_glob()). =back @@ -266,7 +296,7 @@ Expand patterns that start with '~' to user name home directories. =item C For convenience, C is a synonym for -C. +C. =back @@ -275,9 +305,21 @@ extensions C, and C flags have not been implemented in the Perl version because they involve more complex interaction with the underlying C structures. +The following flag has been added in the Perl implementation for +compatibility with common flavors of csh: + +=over 4 + +=item C + +If C is not in effect, sort filenames is alphabetical +order (case does not matter) rather than in ASCII order. + +=back + =head1 DIAGNOSTICS -glob() returns a list of matching paths, possibly zero length. If an +bsd_glob() returns a list of matching paths, possibly zero length. If an error occurred, &File::Glob::GLOB_ERROR will be non-zero and C<$!> will be set. &File::Glob::GLOB_ERROR is guaranteed to be zero if no error occurred, or one of the following values otherwise: @@ -294,12 +336,12 @@ The glob was stopped because an error was encountered. =back -In the case where glob() has found some matching paths, but is -interrupted by an error, glob() will return a list of filenames B +In the case where bsd_glob() has found some matching paths, but is +interrupted by an error, it will return a list of filenames B set &File::Glob::ERROR. -Note that glob() deviates from POSIX and FreeBSD glob(3) behaviour by -not considering C and C as errors - glob() will +Note that bsd_glob() deviates from POSIX and FreeBSD glob(3) behaviour +by not considering C and C as errors - bsd_glob() will continue processing despite those errors, unless the C flag is set. @@ -311,10 +353,10 @@ Be aware that all filenames returned from File::Glob are tainted. =item * -If you want to use multiple patterns, e.g. C, you should -probably throw them in a set as in C. This is because -the argument to glob isn't subjected to parsing by the C shell. Remember -that you can use a backslash to escape things. +If you want to use multiple patterns, e.g. C, you should +probably throw them in a set as in C. This is because +the argument to bsd_glob() isn't subjected to parsing by the C shell. +Remember that you can use a backslash to escape things. =item * @@ -334,14 +376,32 @@ Win32 users should use the real slash. If you really want to use backslashes, consider using Sarathy's File::DosGlob, which comes with the standard Perl distribution. +=item * + +Mac OS (Classic) users should note a few differences. Since +Mac OS is not Unix, when the glob code encounters a tilde glob (e.g. +~user/foo) and the C flag is used, it simply returns that +pattern without doing any expansion. + +Glob on Mac OS is case-insensitive by default (if you don't use any +flags). If you specify any flags at all and still want glob +to be case-insensitive, you must include C in the flags. + +The path separator is ':' (aka colon), not '/' (aka slash). Mac OS users +should be careful about specifying relative pathnames. While a full path +always begins with a volume name, a relative pathname should always +begin with a ':'. If specifying a volume name only, a trailing ':' is +required. + =back =head1 AUTHOR The Perl interface was written by Nathan Torkington Egnat@frii.comE, and is released under the artistic license. Further modifications were -made by Greg Bacon Egbacon@cs.uah.eduE and Gurusamy Sarathy -Egsar@activestate.comE. The C glob code has the +made by Greg Bacon Egbacon@cs.uah.eduE, Gurusamy Sarathy +Egsar@activestate.comE, and Thomas Wegner +Ewegner_thomas@yahoo.comE. The C glob code has the following copyright: Copyright (c) 1989, 1993 The Regents of the University of California. diff --git a/contrib/perl5/ext/File/Glob/Glob.xs b/contrib/perl5/ext/File/Glob/Glob.xs index e01ae7e85a94..ee8c0c9751fc 100644 --- a/contrib/perl5/ext/File/Glob/Glob.xs +++ b/contrib/perl5/ext/File/Glob/Glob.xs @@ -4,16 +4,9 @@ #include "bsd_glob.h" +/* XXX: need some thread awareness */ static int GLOB_ERROR = 0; -static int -not_here(char *s) -{ - croak("%s not implemented on this architecture", s); - return -1; -} - - static double constant(char *name, int arg) { @@ -27,6 +20,12 @@ constant(char *name, int arg) return GLOB_ABEND; #else goto not_there; +#endif + if (strEQ(name, "GLOB_ALPHASORT")) +#ifdef GLOB_ALPHASORT + return GLOB_ALPHASORT; +#else + goto not_there; #endif if (strEQ(name, "GLOB_ALTDIRFUNC")) #ifdef GLOB_ALTDIRFUNC diff --git a/contrib/perl5/ext/File/Glob/bsd_glob.c b/contrib/perl5/ext/File/Glob/bsd_glob.c index 62bfe4f80c8a..15ee659c8584 100644 --- a/contrib/perl5/ext/File/Glob/bsd_glob.c +++ b/contrib/perl5/ext/File/Glob/bsd_glob.c @@ -57,6 +57,9 @@ static char sccsid[] = "@(#)glob.c 8.3 (Berkeley) 10/13/93"; * expand {1,2}{a,b} to 1a 1b 2a 2b * gl_matchc: * Number of matches in the current invocation of glob. + * GLOB_ALPHASORT: + * sort alphabetically like csh (case doesn't matter) instead of in ASCII + * order */ #include @@ -76,8 +79,11 @@ static char sccsid[] = "@(#)glob.c 8.3 (Berkeley) 10/13/93"; #ifndef MAXPATHLEN # ifdef PATH_MAX # define MAXPATHLEN PATH_MAX -# else -# define MAXPATHLEN 1024 +# ifdef MACOS_TRADITIONAL +# define MAXPATHLEN 255 +# else +# define MAXPATHLEN 1024 +# endif # endif #endif @@ -90,7 +96,11 @@ static char sccsid[] = "@(#)glob.c 8.3 (Berkeley) 10/13/93"; #define BG_QUOTE '\\' #define BG_RANGE '-' #define BG_RBRACKET ']' -#define BG_SEP '/' +#ifdef MACOS_TRADITIONAL +# define BG_SEP ':' +#else +# define BG_SEP '/' +#endif #ifdef DOSISH #define BG_SEP2 '\\' #endif @@ -448,6 +458,12 @@ glob0(const Char *pattern, glob_t *pglob) int c, err, oldflags, oldpathc; Char *bufnext, patbuf[MAXPATHLEN+1]; +#ifdef MACOS_TRADITIONAL + if ( (*pattern == BG_TILDE) && (pglob->gl_flags & GLOB_TILDE) ) { + return(globextend(pattern, pglob)); + } +#endif + qpat = globtilde(pattern, patbuf, pglob); qpatnext = qpat; oldflags = pglob->gl_flags; @@ -531,7 +547,8 @@ glob0(const Char *pattern, glob_t *pglob) else if (!(pglob->gl_flags & GLOB_NOSORT)) qsort(pglob->gl_pathv + pglob->gl_offs + oldpathc, pglob->gl_pathc - oldpathc, sizeof(char *), - (pglob->gl_flags & GLOB_NOCASE) ? ci_compare : compare); + (pglob->gl_flags & (GLOB_ALPHASORT|GLOB_NOCASE)) + ? ci_compare : compare); pglob->gl_flags = oldflags; return(0); } @@ -541,13 +558,17 @@ ci_compare(const void *p, const void *q) { const char *pp = *(const char **)p; const char *qq = *(const char **)q; + int ci; while (*pp && *qq) { if (tolower(*pp) != tolower(*qq)) break; ++pp; ++qq; } - return (tolower(*pp) - tolower(*qq)); + ci = tolower(*pp) - tolower(*qq); + if (ci == 0) + return compare(p, q); + return ci; } static int @@ -653,7 +674,7 @@ glob3(Char *pathbuf, Char *pathend, Char *pattern, * and dirent.h as taking pointers to differently typed opaque * structures. */ - Direntry_t *(*readdirfunc)(); + Direntry_t *(*readdirfunc)(DIR*); *pathend = BG_EOS; errno = 0; @@ -689,7 +710,7 @@ glob3(Char *pathbuf, Char *pathend, Char *pattern, /* Search directory for matching names. */ if (pglob->gl_flags & GLOB_ALTDIRFUNC) - readdirfunc = pglob->gl_readdir; + readdirfunc = (Direntry_t *(*)(DIR *))pglob->gl_readdir; else readdirfunc = my_readdir; while ((dp = (*readdirfunc)(dirp))) { @@ -853,10 +874,15 @@ g_opendir(register Char *str, glob_t *pglob) { char buf[MAXPATHLEN]; - if (!*str) + if (!*str) { +#ifdef MACOS_TRADITIONAL + strcpy(buf, ":"); +#else strcpy(buf, "."); - else +#endif + } else { g_Ctoc(str, buf); + } if (pglob->gl_flags & GLOB_ALTDIRFUNC) return((*pglob->gl_opendir)(buf)); diff --git a/contrib/perl5/ext/File/Glob/bsd_glob.h b/contrib/perl5/ext/File/Glob/bsd_glob.h index 10d1de534c64..5d04fff1c341 100644 --- a/contrib/perl5/ext/File/Glob/bsd_glob.h +++ b/contrib/perl5/ext/File/Glob/bsd_glob.h @@ -72,6 +72,7 @@ typedef struct { #define GLOB_QUOTE 0x0400 /* Quote special chars with \. */ #define GLOB_TILDE 0x0800 /* Expand tilde names from the passwd file. */ #define GLOB_NOCASE 0x1000 /* Treat filenames without regard for case. */ +#define GLOB_ALPHASORT 0x2000 /* Alphabetic, not ASCII sort, like csh. */ #define GLOB_NOSPACE (-1) /* Malloc call failed. */ #define GLOB_ABEND (-2) /* Unignored error. */ diff --git a/contrib/perl5/ext/GDBM_File/GDBM_File.pm b/contrib/perl5/ext/GDBM_File/GDBM_File.pm index ab866eecabed..310243c736e8 100644 --- a/contrib/perl5/ext/GDBM_File/GDBM_File.pm +++ b/contrib/perl5/ext/GDBM_File/GDBM_File.pm @@ -40,6 +40,7 @@ L, L, L. package GDBM_File; use strict; +use warnings; our($VERSION, @ISA, @EXPORT, $AUTOLOAD); require Carp; @@ -53,13 +54,14 @@ use XSLoader (); GDBM_FAST GDBM_INSERT GDBM_NEWDB + GDBM_NOLOCK GDBM_READER GDBM_REPLACE GDBM_WRCREAT GDBM_WRITER ); -$VERSION = "1.03"; +$VERSION = "1.05"; sub AUTOLOAD { my($constname); diff --git a/contrib/perl5/ext/GDBM_File/GDBM_File.xs b/contrib/perl5/ext/GDBM_File/GDBM_File.xs index 870f056c9bf0..5e426f90f32d 100644 --- a/contrib/perl5/ext/GDBM_File/GDBM_File.xs +++ b/contrib/perl5/ext/GDBM_File/GDBM_File.xs @@ -42,12 +42,14 @@ typedef datum datum_value ; typedef void (*FATALFUNC)(); +#ifndef GDBM_FAST static int not_here(char *s) { croak("GDBM_File::%s not implemented on this architecture", s); return -1; } +#endif /* GDBM allocates the datum with system malloc() and expects the user * to free() it. So we either have to free() it immediately, or have @@ -56,7 +58,7 @@ not_here(char *s) static void output_datum(pTHX_ SV *arg, char *str, int size) { -#if !defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC)) +#if !defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC) && !defined(LEAKTEST)) sv_usepvn(arg, str, size); #else sv_setpvn(arg, str, size); @@ -121,6 +123,12 @@ constant(char *name, int arg) return GDBM_NEWDB; #else goto not_there; +#endif + if (strEQ(name, "GDBM_NOLOCK")) +#ifdef GDBM_NOLOCK + return GDBM_NOLOCK; +#else + goto not_there; #endif if (strEQ(name, "GDBM_READER")) #ifdef GDBM_READER @@ -214,7 +222,7 @@ gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak) GDBM_FILE dbp ; RETVAL = NULL ; - if (dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func)) { + if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) { RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ; Zero(RETVAL, 1, GDBM_File_type) ; RETVAL->dbp = dbp ; diff --git a/contrib/perl5/ext/GDBM_File/typemap b/contrib/perl5/ext/GDBM_File/typemap index 4f79ae3e32a5..1dd063003ab6 100644 --- a/contrib/perl5/ext/GDBM_File/typemap +++ b/contrib/perl5/ext/GDBM_File/typemap @@ -19,8 +19,14 @@ T_DATUM_K $var.dsize = (int)PL_na; T_DATUM_V ckFilter($arg, filter_store_value, \"filter_store_value\"); - $var.dptr = SvPV($arg, PL_na); - $var.dsize = (int)PL_na; + if (SvOK($arg)) { + $var.dptr = SvPV($arg, PL_na); + $var.dsize = (int)PL_na; + } + else { + $var.dptr = \"\"; + $var.dsize = 0; + } OUTPUT T_DATUM_K output_datum(aTHX_ $arg, $var.dptr, $var.dsize); diff --git a/contrib/perl5/ext/IO/IO.xs b/contrib/perl5/ext/IO/IO.xs index 1b79cfd4c093..38acf4114843 100644 --- a/contrib/perl5/ext/IO/IO.xs +++ b/contrib/perl5/ext/IO/IO.xs @@ -136,18 +136,23 @@ io_blocking(InputStream f, int block) MODULE = IO PACKAGE = IO::Seekable PREFIX = f -SV * +void fgetpos(handle) InputStream handle CODE: if (handle) { Fpos_t pos; + if ( #ifdef PerlIO - PerlIO_getpos(handle, &pos); + PerlIO_getpos(handle, &pos) #else - fgetpos(handle, &pos); + fgetpos(handle, &pos) #endif - ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t))); + ) { + ST(0) = &PL_sv_undef; + } else { + ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t))); + } } else { ST(0) = &PL_sv_undef; @@ -176,7 +181,7 @@ fsetpos(handle, pos) MODULE = IO PACKAGE = IO::File PREFIX = f -SV * +void new_tmpfile(packname = "IO::File") char * packname PREINIT: diff --git a/contrib/perl5/ext/IO/lib/IO/Handle.pm b/contrib/perl5/ext/IO/lib/IO/Handle.pm index 930df55fec8b..fb754a60bfae 100644 --- a/contrib/perl5/ext/IO/lib/IO/Handle.pm +++ b/contrib/perl5/ext/IO/lib/IO/Handle.pm @@ -71,7 +71,7 @@ corresponding built-in functions: $io->printf ( FMT, [ARGS] ) $io->stat $io->sysread ( BUF, LEN, [OFFSET] ) - $io->syswrite ( BUF, LEN, [OFFSET] ) + $io->syswrite ( BUF, [LEN, [OFFSET]] ) $io->truncate ( LEN ) See L for complete descriptions of each of the following @@ -110,18 +110,19 @@ or a file descriptor number. =item $io->opened -Returns true if the object is currently a valid file descriptor. +Returns true if the object is currently a valid file descriptor, false +otherwise. =item $io->getline This works like <$io> described in L -except that it's more readable and can be safely called in an -array context but still returns just one line. +except that it's more readable and can be safely called in a +list context but still returns just one line. =item $io->getlines -This works like <$io> when called in an array context to -read all the remaining lines in a file, except that it's more readable. +This works like <$io> when called in a list context to read all +the remaining lines in a file, except that it's more readable. It will also croak() if accidentally called in a scalar context. =item $io->ungetc ( ORD ) @@ -139,31 +140,37 @@ called C. =item $io->error Returns a true value if the given handle has experienced any errors -since it was opened or since the last call to C. +since it was opened or since the last call to C, or if the +handle is invalid. It only returns false for a valid handle with no +outstanding errors. =item $io->clearerr -Clear the given handle's error indicator. +Clear the given handle's error indicator. Returns -1 if the handle is +invalid, 0 otherwise. =item $io->sync C synchronizes a file's in-memory state with that on the physical medium. C does not operate at the perlio api level, but -operates on the file descriptor, this means that any data held at the -perlio api level will not be synchronized. To synchronize data that is -buffered at the perlio api level you must use the flush method. C -is not implemented on all platforms. See L. +operates on the file descriptor (similar to sysread, sysseek and +systell). This means that any data held at the perlio api level will not +be synchronized. To synchronize data that is buffered at the perlio api +level you must use the flush method. C is not implemented on all +platforms. Returns "0 but true" on success, C on error, C +for an invalid handle. See L. =item $io->flush C causes perl to flush any buffered data at the perlio api level. Any unread data in the buffer will be discarded, and any unwritten data -will be written to the underlying file descriptor. +will be written to the underlying file descriptor. Returns "0 but true" +on success, C on error. =item $io->printflush ( ARGS ) Turns on autoflush, print ARGS and then restores the autoflush status of the -C object. +C object. Returns the return value from print. =item $io->blocking ( [ BOOL ] ) @@ -183,11 +190,18 @@ C and C set the buffering policy for an IO::Handle. The calling sequences for the Perl functions are the same as their C counterparts--including the constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter -specifies a scalar variable to use as a buffer. WARNING: A variable -used as a buffer by C or C must not be modified in any -way until the IO::Handle is closed or C or C is called -again, or memory corruption may result! Note that you need to import -the constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. +specifies a scalar variable to use as a buffer. You should only +change the buffer before any I/O, or immediately after calling flush. + +WARNING: A variable used as a buffer by C or C B in any way until the IO::Handle is closed or C or +C is called again, or memory corruption may result! Remember that +the order of global destruction is undefined, so even if your buffer +variable remains in scope until program termination, it may be undefined +before the file IO::Handle is closed. Note that you need to import the +constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf +returns nothing. setvbuf returns "0 but true", on success, C on +failure. Lastly, there is a special method for working under B<-T> and setuid/gid scripts: @@ -199,7 +213,8 @@ scripts: Marks the object as taint-clean, and as such data read from it will also be considered taint-clean. Note that this is a very trusting action to take, and appropriate consideration for the data source and potential -vulnerability should be kept in mind. +vulnerability should be kept in mind. Returns 0 on success, -1 if setting +the taint-clean flag failed. (eg invalid handle) =back @@ -425,8 +440,11 @@ sub write { sub syswrite { @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])'; - $_[2] = length($_[1]) unless defined $_[2]; - syswrite($_[0], $_[1], $_[2], $_[3] || 0); + if (defined($_[2])) { + syswrite($_[0], $_[1], $_[2], $_[3] || 0); + } else { + syswrite($_[0], $_[1]); + } } sub stat { diff --git a/contrib/perl5/ext/IO/lib/IO/Poll.pm b/contrib/perl5/ext/IO/lib/IO/Poll.pm index 687664b9abfa..70a3469edbb2 100644 --- a/contrib/perl5/ext/IO/lib/IO/Poll.pm +++ b/contrib/perl5/ext/IO/lib/IO/Poll.pm @@ -1,3 +1,4 @@ + # IO::Poll.pm # # Copyright (c) 1997-8 Graham Barr . All rights reserved. @@ -12,28 +13,31 @@ use Exporter (); our(@ISA, @EXPORT_OK, @EXPORT, $VERSION); @ISA = qw(Exporter); -$VERSION = "0.01"; +$VERSION = "0.05"; -@EXPORT = qw(poll); +@EXPORT = qw( POLLIN + POLLOUT + POLLERR + POLLHUP + POLLNVAL + ); @EXPORT_OK = qw( - POLLIN POLLPRI - POLLOUT POLLRDNORM POLLWRNORM POLLRDBAND POLLWRBAND POLLNORM - POLLERR - POLLHUP - POLLNVAL -); + ); +# [0] maps fd's to requested masks +# [1] maps fd's to returned masks +# [2] maps fd's to handles sub new { my $class = shift; - my $self = bless [{},{}], $class; + my $self = bless [{},{},{}], $class; $self; } @@ -42,20 +46,21 @@ sub mask { my $self = shift; my $io = shift; my $fd = fileno($io); - if(@_) { + if (@_) { my $mask = shift; - $self->[0]{$fd} ||= {}; if($mask) { - $self->[0]{$fd}{$io} = $mask; - } - else { + $self->[0]{$fd}{$io} = $mask; # the error events are always returned + $self->[1]{$fd} = 0; # output mask + $self->[2]{$io} = $io; # remember handle + } else { delete $self->[0]{$fd}{$io}; + delete $self->[1]{$fd} unless %{$self->[0]{$fd}}; + delete $self->[2]{$io}; } } - elsif(exists $self->[0]{$fd}{$io}) { + + return unless exists $self->[0]{$fd} and exists $self->[0]{$fd}{$io}; return $self->[0]{$fd}{$io}; - } - return; } @@ -64,13 +69,13 @@ sub poll { $self->[1] = {}; - my($fd,$ref); + my($fd,$mask,$iom); my @poll = (); - while(($fd,$ref) = each %{$self->[0]}) { - my $events = 0; - map { $events |= $_ } values %{$ref}; - push(@poll,$fd, $events); + while(($fd,$iom) = each %{$self->[0]}) { + $mask = 0; + $mask |= $_ for values(%$iom); + push(@poll,$fd => $mask); } my $ret = @poll ? _poll(defined($timeout) ? $timeout * 1000 : -1,@poll) : 0; @@ -80,8 +85,7 @@ sub poll { while(@poll) { my($fd,$got) = splice(@poll,0,2); - $self->[1]{$fd} = $got - if $got; + $self->[1]{$fd} = $got if $got; } return $ret; @@ -91,9 +95,8 @@ sub events { my $self = shift; my $io = shift; my $fd = fileno($io); - - exists $self->[1]{$fd} && exists $self->[0]{$fd}{$io} - ? $self->[1]{$fd} & $self->[0]{$fd}{$io} + exists $self->[1]{$fd} and exists $self->[0]{$fd}{$io} + ? $self->[1]{$fd} & ($self->[0]{$fd}{$io}|POLLHUP|POLLERR|POLLNVAL) : 0; } @@ -105,20 +108,16 @@ sub remove { sub handles { my $self = shift; - - return map { keys %$_ } values %{$self->[0]} - unless(@_); + return values %{$self->[2]} unless @_; my $events = shift || 0; my($fd,$ev,$io,$mask); my @handles = (); while(($fd,$ev) = each %{$self->[1]}) { - if($ev & $events) { - while(($io,$mask) = each %{$self->[0][$fd]}) { - push(@handles, $io) - if $events & $mask; - } + while (($io,$mask) = each %{$self->[0]{$fd}}) { + $mask |= POLLHUP|POLLERR|POLLNVAL; # must allow these + push @handles,$self->[2]{$io} if ($ev & $mask) & $events; } } return @handles; @@ -138,8 +137,8 @@ IO::Poll - Object interface to system poll call $poll = new IO::Poll; - $poll->mask($input_handle => POLLRDNORM | POLLIN | POLLHUP); - $poll->mask($output_handle => POLLWRNORM); + $poll->mask($input_handle => POLLIN); + $poll->mask($output_handle => POLLOUT); $poll->poll($timeout); diff --git a/contrib/perl5/ext/IO/lib/IO/Seekable.pm b/contrib/perl5/ext/IO/lib/IO/Seekable.pm index e09d48b9bff8..243a971acccc 100644 --- a/contrib/perl5/ext/IO/lib/IO/Seekable.pm +++ b/contrib/perl5/ext/IO/lib/IO/Seekable.pm @@ -18,19 +18,69 @@ C does not have a constructor of its own as it is intended to be inherited by other C based objects. It provides methods which allow seeking of the file descriptors. -If the C functions fgetpos() and fsetpos() are available, then -C<$io-Egetpos> returns an opaque value that represents the -current position of the IO::File, and C<$io-Esetpos(POS)> uses -that value to return to a previously visited position. +=over 4 +=item $io->getpos + +Returns an opaque value that represents the current position of the +IO::File, or C if this is not possible (eg an unseekable stream such +as a terminal, pipe or socket). If the fgetpos() function is available in +your C library it is used to implements getpos, else perl emulates getpos +using C's ftell() function. + +=item $io->setpos + +Uses the value of a previous getpos call to return to a previously visited +position. Returns "0 but true" on success, C on failure. + +=back + See L for complete descriptions of each of the following supported C methods, which are just front ends for the corresponding built-in functions: - $io->seek( POS, WHENCE ) - $io->sysseek( POS, WHENCE ) - $io->tell +=over 4 +=item $io->setpos ( POS, WHENCE ) + +Seek the IO::File to position POS, relative to WHENCE: + +=over 8 + +=item WHENCE=0 (SEEK_SET) + +POS is absolute position. (Seek relative to the start of the file) + +=item WHENCE=1 (SEEK_CUR) + +POS is an offset from the current position. (Seek relative to current) + +=item WHENCE=1 (SEEK_END) + +POS is an offset from the end of the file. (Seek relative to end) + +=back + +The SEEK_* constants can be imported from the C module if you +don't wish to use the numbers C<0> C<1> or C<2> in your code. + +Returns C<1> upon success, C<0> otherwise. + +=item $io->sysseek( POS, WHENCE ) + +Similar to $io->seek, but sets the IO::File's position using the system +call lseek(2) directly, so will confuse most perl IO operators except +sysread and syswrite (see L for full details) + +Returns the new position, or C on failure. A position +of zero is returned as the string C<"0 but true"> + +=item $io->tell + +Returns the IO::File's current position, or -1 on error. + +=back + =head1 SEE ALSO L, diff --git a/contrib/perl5/ext/IO/lib/IO/Select.pm b/contrib/perl5/ext/IO/lib/IO/Select.pm index df92b04b74f3..1a3a26fe6ae3 100644 --- a/contrib/perl5/ext/IO/lib/IO/Select.pm +++ b/contrib/perl5/ext/IO/lib/IO/Select.pm @@ -56,6 +56,7 @@ sub exists sub _fileno { my($self, $f) = @_; + return unless defined $f; $f = $f->[0] if ref($f) eq 'ARRAY'; ($f =~ /^\d+$/) ? $f : fileno($f); } @@ -300,9 +301,9 @@ Return an array of all registered handles. =item can_read ( [ TIMEOUT ] ) Return an array of handles that are ready for reading. C is -the maximum amount of time to wait before returning an empty list. If -C is not given and any handles are registered then the call -will block. +the maximum amount of time to wait before returning an empty list, in +seconds, possibly fractional. If C is not given and any +handles are registered then the call will block. =item can_write ( [ TIMEOUT ] ) diff --git a/contrib/perl5/ext/IO/lib/IO/Socket.pm b/contrib/perl5/ext/IO/lib/IO/Socket.pm index 6884f02cf868..b8da0926692d 100644 --- a/contrib/perl5/ext/IO/lib/IO/Socket.pm +++ b/contrib/perl5/ext/IO/lib/IO/Socket.pm @@ -361,7 +361,7 @@ perform the system call C on the socket and return a new object. The new object will be created in the same class as the listen socket, unless C 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 an array context a two-element array 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. diff --git a/contrib/perl5/ext/IO/lib/IO/Socket/INET.pm b/contrib/perl5/ext/IO/lib/IO/Socket/INET.pm index 27a3d4d847ee..d2cc488dd2d8 100644 --- a/contrib/perl5/ext/IO/lib/IO/Socket/INET.pm +++ b/contrib/perl5/ext/IO/lib/IO/Socket/INET.pm @@ -34,6 +34,7 @@ sub new { sub _sock_info { my($addr,$port,$proto) = @_; + my $origport = $port; my @proto = (); my @serv = (); @@ -59,14 +60,14 @@ sub _sock_info { my $defport = $1 || undef; my $pnum = ($port =~ m,^(\d+)$,)[0]; - if ($port =~ m,\D,) { - unless (@serv = getservbyname($port, $proto[0] || "")) { - $@ = "Bad service '$port'"; - return; - } - } + @serv = getservbyname($port, $proto[0] || "") + if ($port =~ m,\D,); $port = $pnum || $serv[2] || $defport || undef; + unless (defined $port) { + $@ = "Bad service '$origport'"; + return; + } $proto = (getprotobyname($serv[3]))[2] || undef if @serv && !$proto; @@ -150,11 +151,16 @@ sub configure { $sock->socket(AF_INET, $type, $proto) or return _error($sock, $!, "$!"); - if ($arg->{Reuse}) { + if ($arg->{Reuse} || $arg->{ReuseAddr}) { $sock->sockopt(SO_REUSEADDR,1) or return _error($sock, $!, "$!"); } + if ($arg->{ReusePort}) { + $sock->sockopt(SO_REUSEPORT,1) or + return _error($sock, $!, "$!"); + } + if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) { $sock->bind($lport || 0, $laddr) or return _error($sock, $!, "$!"); @@ -301,7 +307,9 @@ C provides. Proto Protocol name (or number) "tcp" | "udp" | ... Type Socket type SOCK_STREAM | SOCK_DGRAM | ... Listen Queue size for listen - Reuse Set SO_REUSEADDR before binding + ReuseAddr Set SO_REUSEADDR before binding + Reuse Set SO_REUSEADDR before binding (deprecated, prefer ReuseAddr) + ReusePort Set SO_REUSEPORT before binding Timeout Timeout value for various operations MultiHomed Try all adresses for multi-homed hosts diff --git a/contrib/perl5/ext/IO/lib/IO/Socket/UNIX.pm b/contrib/perl5/ext/IO/lib/IO/Socket/UNIX.pm index d083f48b78f7..2a11752d027a 100644 --- a/contrib/perl5/ext/IO/lib/IO/Socket/UNIX.pm +++ b/contrib/perl5/ext/IO/lib/IO/Socket/UNIX.pm @@ -37,7 +37,7 @@ sub configure { $sock->bind($addr) or return undef; } - if(exists $arg->{Listen}) { + if(exists $arg->{Listen} && $type != SOCK_DGRAM) { $sock->listen($arg->{Listen} || 5) or return undef; } diff --git a/contrib/perl5/ext/IPC/SysV/Makefile.PL b/contrib/perl5/ext/IPC/SysV/Makefile.PL index 60dd74d9a9c4..f994950d195a 100644 --- a/contrib/perl5/ext/IPC/SysV/Makefile.PL +++ b/contrib/perl5/ext/IPC/SysV/Makefile.PL @@ -31,7 +31,7 @@ WriteMakefile( 'clean' => {FILES => join(" ", map { "$_ */$_ */*/$_" } - qw(*% *.html *.b[ac]k *.old *.orig)) + qw(*% *.html *.b[ac]k *.old)) }, 'macro' => { INSTALLDIRS => 'perl' }, ); diff --git a/contrib/perl5/ext/IPC/SysV/SysV.xs b/contrib/perl5/ext/IPC/SysV/SysV.xs index 38062e028b5e..c7985f99fe3e 100644 --- a/contrib/perl5/ext/IPC/SysV/SysV.xs +++ b/contrib/perl5/ext/IPC/SysV/SysV.xs @@ -194,7 +194,7 @@ PPCODE: MODULE=IPC::SysV PACKAGE=IPC::SysV -int +void ftok(path, id) char * path int id @@ -203,10 +203,10 @@ ftok(path, id) key_t k = ftok(path, id); ST(0) = k == (key_t) -1 ? &PL_sv_undef : sv_2mortal(newSViv(k)); #else - DIE(PL_no_func, "ftok"); + DIE(aTHX_ PL_no_func, "ftok"); #endif -int +void SHMLBA() CODE: #ifdef SHMLBA @@ -436,7 +436,7 @@ BOOT: char *name; int i; - for(i = 0 ; name = IPC__SysV__const[i].n ; i++) { + for(i = 0 ; (name = IPC__SysV__const[i].n) ; i++) { newCONSTSUB(stash,name, newSViv(IPC__SysV__const[i].v)); } } diff --git a/contrib/perl5/ext/NDBM_File/Makefile.PL b/contrib/perl5/ext/NDBM_File/Makefile.PL index 6ceab55a4aed..7b586017d7d4 100644 --- a/contrib/perl5/ext/NDBM_File/Makefile.PL +++ b/contrib/perl5/ext/NDBM_File/Makefile.PL @@ -5,4 +5,5 @@ WriteMakefile( MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'NDBM_File.pm', + INC => ($^O eq "MacOS" ? "-i ::::db:include" : "") ); diff --git a/contrib/perl5/ext/NDBM_File/NDBM_File.pm b/contrib/perl5/ext/NDBM_File/NDBM_File.pm index f98669f4860d..b2804597a14e 100644 --- a/contrib/perl5/ext/NDBM_File/NDBM_File.pm +++ b/contrib/perl5/ext/NDBM_File/NDBM_File.pm @@ -1,16 +1,13 @@ package NDBM_File; -BEGIN { - if ($] >= 5.002) { - use strict; - } -} +use strict; +use warnings; require Tie::Hash; use XSLoader (); our @ISA = qw(Tie::Hash); -our $VERSION = "1.03"; +our $VERSION = "1.04"; XSLoader::load 'NDBM_File', $VERSION; @@ -24,15 +21,93 @@ NDBM_File - Tied access to ndbm files =head1 SYNOPSIS - use NDBM_File; - use Fcntl; # for O_ constants - - tie(%h, 'NDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640); - - untie %h; + use Fcntl; # For O_RDWR, O_CREAT, etc. + use NDBM_File; + # Now read and change the hash + $h{newkey} = newvalue; + print $h{oldkey}; + ... + + untie %h; + =head1 DESCRIPTION + +C establishes a connection between a Perl hash variable and +a file in NDBM_File format;. You can manipulate the data in the file +just as if it were in a Perl hash, but when your program exits, the +data will remain in the file, to be used the next time your program +runs. -See L, L +Use C with the Perl built-in C function to establish +the connection between the variable and the file. The arguments to +C should be: + +=over 4 + +=item 1. + +The hash variable you want to tie. + +=item 2. + +The string C<"NDBM_File">. (Ths tells Perl to use the C +package to perform the functions of the hash.) + +=item 3. + +The name of the file you want to tie to the hash. + +=item 4. + +Flags. Use one of: + +=over 2 + +=item C + +Read-only access to the data in the file. + +=item C + +Write-only access to the data in the file. + +=item C + +Both read and write access. + +=back + +If you want to create the file if it does not exist, add C to +any of these, as in the example. If you omit C and the file +does not already exist, the C call will fail. + +=item 5. + +The default permissions to use if a new file is created. The actual +permissions will be modified by the user's umask, so you should +probably use 0666 here. (See L.) + +=back + +=head1 DIAGNOSTICS + +On failure, the C call returns an undefined value and probably +sets C<$!> to contain the reason the file could not be tied. + +=head2 C + +This warning is emmitted when you try to store a key or a value that +is too long. It means that the change was not recorded in the +database. See BUGS AND WARNINGS below. + +=head1 BUGS AND WARNINGS + +There are a number of limits on the size of the data that you can +store in the NDBM file. The most important is that the length of a +key, plus the length of its associated value, may not exceed 1008 +bytes. + +See L, L, L =cut diff --git a/contrib/perl5/ext/NDBM_File/NDBM_File.xs b/contrib/perl5/ext/NDBM_File/NDBM_File.xs index 49a1db5e5657..c417eb693e92 100644 --- a/contrib/perl5/ext/NDBM_File/NDBM_File.xs +++ b/contrib/perl5/ext/NDBM_File/NDBM_File.xs @@ -1,6 +1,11 @@ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +/* If using the DB3 emulation, ENTER is defined both + * by DB3 and Perl. We drop the Perl definition now. + * See also INSTALL section on DB3. + * -- Stanislav Brabec */ +#undef ENTER #include typedef struct { diff --git a/contrib/perl5/ext/NDBM_File/typemap b/contrib/perl5/ext/NDBM_File/typemap index eeb5d59027f5..40b95f22c022 100644 --- a/contrib/perl5/ext/NDBM_File/typemap +++ b/contrib/perl5/ext/NDBM_File/typemap @@ -20,8 +20,14 @@ T_DATUM_K $var.dsize = (int)PL_na; T_DATUM_V ckFilter($arg, filter_store_value, \"filter_store_value\"); - $var.dptr = SvPV($arg, PL_na); - $var.dsize = (int)PL_na; + if (SvOK($arg)) { + $var.dptr = SvPV($arg, PL_na); + $var.dsize = (int)PL_na; + } + else { + $var.dptr = \"\"; + $var.dsize = 0; + } T_GDATUM UNIMPLEMENTED OUTPUT diff --git a/contrib/perl5/ext/ODBM_File/ODBM_File.pm b/contrib/perl5/ext/ODBM_File/ODBM_File.pm index 57fe4c352ddd..9e8e008e0243 100644 --- a/contrib/perl5/ext/ODBM_File/ODBM_File.pm +++ b/contrib/perl5/ext/ODBM_File/ODBM_File.pm @@ -1,12 +1,13 @@ package ODBM_File; use strict; +use warnings; require Tie::Hash; use XSLoader (); our @ISA = qw(Tie::Hash); -our $VERSION = "1.02"; +our $VERSION = "1.03"; XSLoader::load 'ODBM_File', $VERSION; @@ -20,14 +21,93 @@ ODBM_File - Tied access to odbm files =head1 SYNOPSIS + use Fcntl; # For O_RDWR, O_CREAT, etc. use ODBM_File; - tie(%h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640); - - untie %h; - + # Now read and change the hash + $h{newkey} = newvalue; + print $h{oldkey}; + ... + + untie %h; + =head1 DESCRIPTION + +C establishes a connection between a Perl hash variable and +a file in ODBM_File format;. You can manipulate the data in the file +just as if it were in a Perl hash, but when your program exits, the +data will remain in the file, to be used the next time your program +runs. -See L, L +Use C with the Perl built-in C function to establish +the connection between the variable and the file. The arguments to +C should be: + +=over 4 + +=item 1. + +The hash variable you want to tie. + +=item 2. + +The string C<"ODBM_File">. (Ths tells Perl to use the C +package to perform the functions of the hash.) + +=item 3. + +The name of the file you want to tie to the hash. + +=item 4. + +Flags. Use one of: + +=over 2 + +=item C + +Read-only access to the data in the file. + +=item C + +Write-only access to the data in the file. + +=item C + +Both read and write access. + +=back + +If you want to create the file if it does not exist, add C to +any of these, as in the example. If you omit C and the file +does not already exist, the C call will fail. + +=item 5. + +The default permissions to use if a new file is created. The actual +permissions will be modified by the user's umask, so you should +probably use 0666 here. (See L.) + +=back + +=head1 DIAGNOSTICS + +On failure, the C call returns an undefined value and probably +sets C<$!> to contain the reason the file could not be tied. + +=head2 C + +This warning is emmitted when you try to store a key or a value that +is too long. It means that the change was not recorded in the +database. See BUGS AND WARNINGS below. + +=head1 BUGS AND WARNINGS + +There are a number of limits on the size of the data that you can +store in the ODBM file. The most important is that the length of a +key, plus the length of its associated value, may not exceed 1008 +bytes. + +See L, L, L =cut diff --git a/contrib/perl5/ext/ODBM_File/ODBM_File.xs b/contrib/perl5/ext/ODBM_File/ODBM_File.xs index 150f2ef89475..27174ef062b7 100644 --- a/contrib/perl5/ext/ODBM_File/ODBM_File.xs +++ b/contrib/perl5/ext/ODBM_File/ODBM_File.xs @@ -3,6 +3,11 @@ #include "XSUB.h" #ifdef I_DBM +/* If using the DB3 emulation, ENTER is defined both + * by DB3 and Perl. We drop the Perl definition now. + * See also INSTALL section on DB3. + * -- Stanislav Brabec */ +# undef ENTER # include #else # ifdef I_RPCSVC_DBM diff --git a/contrib/perl5/ext/ODBM_File/typemap b/contrib/perl5/ext/ODBM_File/typemap index 7c23815ec75a..096427ea7f3a 100644 --- a/contrib/perl5/ext/ODBM_File/typemap +++ b/contrib/perl5/ext/ODBM_File/typemap @@ -20,8 +20,14 @@ T_DATUM_K $var.dsize = (int)PL_na; T_DATUM_V ckFilter($arg, filter_store_value, \"filter_store_value\"); - $var.dptr = SvPV($arg, PL_na); - $var.dsize = (int)PL_na; + if (SvOK($arg)) { + $var.dptr = SvPV($arg, PL_na); + $var.dsize = (int)PL_na; + } + else { + $var.dptr = \"\"; + $var.dsize = 0; + } T_GDATUM UNIMPLEMENTED OUTPUT diff --git a/contrib/perl5/ext/Opcode/Opcode.pm b/contrib/perl5/ext/Opcode/Opcode.pm index 9338d392fae2..841120c4c63d 100644 --- a/contrib/perl5/ext/Opcode/Opcode.pm +++ b/contrib/perl5/ext/Opcode/Opcode.pm @@ -163,7 +163,7 @@ accumulated set of ops at that point. =item an operator set (opset) -An I as a binary string of approximately 43 bytes which holds a +An I as a binary string of approximately 44 bytes which holds a set or zero or more operators. The opset and opset_to_ops functions can be used to convert from @@ -185,7 +185,7 @@ tags and sets. All are available for export by the package. =item opcodes In a scalar context opcodes returns the number of opcodes in this -version of perl (around 340 for perl5.002). +version of perl (around 350 for perl-5.7.0). In a list context it returns a list of all the operator names. (Not yet implemented, use @names = opset_to_ops(full_opset).) diff --git a/contrib/perl5/ext/Opcode/Opcode.xs b/contrib/perl5/ext/Opcode/Opcode.xs index 581cbc94d939..cc4e1f45e17a 100644 --- a/contrib/perl5/ext/Opcode/Opcode.xs +++ b/contrib/perl5/ext/Opcode/Opcode.xs @@ -250,7 +250,7 @@ PPCODE: save_aptr(&PL_endav); PL_endav = (AV*)sv_2mortal((SV*)newAV()); /* ignore END blocks for now */ - save_hptr(&PL_defstash); /* save current default stack */ + save_hptr(&PL_defstash); /* save current default stash */ /* the assignment to global defstash changes our sense of 'main' */ PL_defstash = gv_stashpv(Package, GV_ADDWARN); /* should exist already */ save_hptr(&PL_curstash); @@ -263,6 +263,11 @@ PPCODE: sv_free((SV*)GvHV(gv)); GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash); + /* %INC must be clean for use/require in compartment */ + save_hash(PL_incgv); + sv_free((SV*)GvHV(PL_incgv)); /* get rid of what save_hash gave us*/ + GvHV(PL_incgv) = (HV*)SvREFCNT_inc(GvHV(gv_HVadd(gv_fetchpv("INC",TRUE,SVt_PVHV)))); + PUSHMARK(SP); perl_call_sv(codesv, GIMME|G_EVAL|G_KEEPERR); /* use callers context */ SPAGAIN; /* for the PUTBACK added by xsubpp */ @@ -320,7 +325,7 @@ PPCODE: void opset(...) CODE: - int i, j; + int i; SV *bitspec, *opset; char *bitmap; STRLEN len, on; diff --git a/contrib/perl5/ext/POSIX/Makefile.PL b/contrib/perl5/ext/POSIX/Makefile.PL index 55c5c1fbf3f6..73bb02dddb54 100644 --- a/contrib/perl5/ext/POSIX/Makefile.PL +++ b/contrib/perl5/ext/POSIX/Makefile.PL @@ -2,12 +2,7 @@ use ExtUtils::MakeMaker; use Config; my @libs; if ($^O ne 'MSWin32') { - if ($Config{archname} =~ /RM\d\d\d-svr4/) { - @libs = ('LIBS' => ["-lm -lc -lposix -lcposix"]); - } - else { - @libs = ('LIBS' => ["-lm -lposix -lcposix"]); - } + @libs = ('LIBS' => ["-lm -lposix -lcposix"]); } WriteMakefile( NAME => 'POSIX', diff --git a/contrib/perl5/ext/POSIX/POSIX.pm b/contrib/perl5/ext/POSIX/POSIX.pm index 9416f70809ab..252e5bbad1cf 100644 --- a/contrib/perl5/ext/POSIX/POSIX.pm +++ b/contrib/perl5/ext/POSIX/POSIX.pm @@ -565,9 +565,9 @@ sub chmod { sub fstat { usage "fstat(fd)" if @_ != 1; local *TMP; - open(TMP, "<&$_[0]"); # Gross. + CORE::open(TMP, "<&$_[0]"); # Gross. my @l = CORE::stat(TMP); - close(TMP); + CORE::close(TMP); @l; } @@ -893,7 +893,7 @@ sub load_imports { difftime mktime strftime tzset tzname)], unistd_h => [qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET - STRERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK + STDERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON _PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX _PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED diff --git a/contrib/perl5/ext/POSIX/POSIX.pod b/contrib/perl5/ext/POSIX/POSIX.pod index 08300e4337b6..49761358ca20 100644 --- a/contrib/perl5/ext/POSIX/POSIX.pod +++ b/contrib/perl5/ext/POSIX/POSIX.pod @@ -65,15 +65,19 @@ all. This could be construed to be a bug. =item _exit -This is identical to the C function C<_exit()>. +This is identical to the C function C<_exit()>. It exits the program +immediately which means among other things buffered I/O is B flushed. =item abort -This is identical to the C function C. +This is identical to the C function C. It terminates the +process with a C signal unless caught by a signal handler or +if the handler does not return normally (it e.g. does a C). =item abs -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function, returning +the absolute value of its numerical argument. =item access @@ -83,83 +87,117 @@ Determines the accessibility of a file. print "have read permission\n"; } -Returns C on failure. +Returns C on failure. Note: do not use C for +security purposes. Between the C call and the operation +you are preparing for the permissions might change: a classic +I. =item acos -This is identical to the C function C. +This is identical to the C function C, returning +the arcus cosine of its numerical argument. See also L. =item alarm -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function, +either for arming or disarming the C timer. =item asctime -This is identical to the C function C. +This is identical to the C function C. It returns +a string of the form + + "Fri Jun 2 18:22:13 2000\n\0" + +and it is called thusly + + $asctime = asctime($sec, $min, $hour, $mday, $mon, $year, + $wday, $yday, $isdst); + +The C<$mon> is zero-based: January equals C<0>. The C<$year> is +1900-based: 2001 equals C<101>. The C<$wday>, C<$yday>, and C<$isdst> +default to zero (and the first two are usually ignored anyway). =item asin -This is identical to the C function C. +This is identical to the C function C, returning +the arcus sine of its numerical argument. See also L. =item assert -Unimplemented. +Unimplemented, but you can use L and the L module +to achieve similar things. =item atan -This is identical to the C function C. +This is identical to the C function C, returning the +arcus tangent of its numerical argument. See also L. =item atan2 -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function, returning +the arcus tangent defined by its two numerical arguments, the I +coordinate and the I coordinate. See also L. =item atexit -atexit() is C-specific: use END {} instead. +atexit() is C-specific: use C instead, see L. =item atof -atof() is C-specific. +atof() is C-specific. Perl converts strings to numbers transparently. +If you need to force a scalar to a number, add a zero to it. =item atoi -atoi() is C-specific. +atoi() is C-specific. Perl converts strings to numbers transparently. +If you need to force a scalar to a number, add a zero to it. +If you need to have just the integer part, see L. =item atol -atol() is C-specific. +atol() is C-specific. Perl converts strings to numbers transparently. +If you need to force a scalar to a number, add a zero to it. +If you need to have just the integer part, see L. =item bsearch -bsearch() not supplied. +bsearch() not supplied. For doing binary search on wordlists, +see L. =item calloc -calloc() is C-specific. +calloc() is C-specific. Perl does memory management transparently. =item ceil -This is identical to the C function C. +This is identical to the C function C, returning the smallest +integer value greater than or equal to the given numerical argument. =item chdir -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function, allowing +one to change the working (default) directory, see L. =item chmod -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function, allowing +one to change file and directory permissions, see L. =item chown -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function, allowing one +to change file and directory owners and groups, see L. =item clearerr -Use method C instead. +Use the method L instead, to reset the error +state (if any) and EOF state (if any) of the given stream. =item clock -This is identical to the C function C. +This is identical to the C function C, returning the +amount of spent processor time in microseconds. =item close @@ -171,17 +209,23 @@ C. Returns C on failure. +See also L. + =item closedir -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for closing +a directory handle, see L. =item cos -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function, for returning +the cosine of its numerical argument, see L. +See also L. =item cosh -This is identical to the C function C. +This is identical to the C function C, for returning +the hyperbolic cosine of its numeric argument. See also L. =item creat @@ -191,6 +235,8 @@ C. Use C to close the file. $fd = POSIX::creat( "foo", 0611 ); POSIX::close( $fd ); +See also L and its C flag. + =item ctermid Generates the path name for the controlling terminal. @@ -199,25 +245,30 @@ Generates the path name for the controlling terminal. =item ctime -This is identical to the C function C. +This is identical to the C function C and equivalent +to C, see L and L. =item cuserid -Get the character login name of the user. +Get the login name of the owner of the current process. $name = POSIX::cuserid(); =item difftime -This is identical to the C function C. +This is identical to the C function C, for returning +the time difference (in seconds) between two times (as returned +by C), see L. =item div -div() is C-specific. +div() is C-specific, use L on the usual C division and +the modulus C<%>. =item dup -This is similar to the C function C. +This is similar to the C function C, for duplicating a file +descriptor. This uses file descriptors such as those obtained by calling C. @@ -226,7 +277,8 @@ Returns C on failure. =item dup2 -This is similar to the C function C. +This is similar to the C function C, for duplicating a file +descriptor to an another known file descriptor. This uses file descriptors such as those obtained by calling C. @@ -239,57 +291,64 @@ Returns the value of errno. $errno = POSIX::errno(); +This identical to the numerical values of the C<$!>, see L. + =item execl -execl() is C-specific. +execl() is C-specific, see L. =item execle -execle() is C-specific. +execle() is C-specific, see L. =item execlp -execlp() is C-specific. +execlp() is C-specific, see L. =item execv -execv() is C-specific. +execv() is C-specific, see L. =item execve -execve() is C-specific. +execve() is C-specific, see L. =item execvp -execvp() is C-specific. +execvp() is C-specific, see L. =item exit -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for exiting the +program, see L. =item exp -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for +returning the exponent (I-based) of the numerical argument, +see L. =item fabs -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for returning +the absolute value of the numerical argument, see L. =item fclose -Use method C instead. +Use method C instead, or see L. =item fcntl -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function, +see L. =item fdopen -Use method C instead. +Use method C instead, or see L. =item feof -Use method C instead. +Use method C instead, or see L. =item ferror @@ -298,38 +357,49 @@ Use method C instead. =item fflush Use method C instead. +See also L. =item fgetc -Use method C instead. +Use method C instead, or see L. =item fgetpos -Use method C instead. +Use method C instead, or see L. =item fgets -Use method C instead. +Use method C instead. Similar to EE, also known +as L. =item fileno -Use method C instead. +Use method C instead, or see L. =item floor -This is identical to the C function C. +This is identical to the C function C, returning the largest +integer value less than or equal to the numerical argument. =item fmod This is identical to the C function C. + $r = modf($x, $y); + +It returns the remainder C<$r = $x - $n*$y>, where C<$n = trunc($x/$y)>. +The C<$r> has the same sign as C<$x> and magnitude (absolute value) +less than the magnitude of C<$y>. + =item fopen -Use method C instead. +Use method C instead, or see L. =item fork -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function +for duplicating the current process, see L +and L if you are in Windows. =item fpathconf @@ -346,45 +416,45 @@ Returns C on failure. =item fprintf -fprintf() is C-specific--use printf instead. +fprintf() is C-specific, see L instead. =item fputc -fputc() is C-specific--use print instead. +fputc() is C-specific, see L instead. =item fputs -fputs() is C-specific--use print instead. +fputs() is C-specific, see L instead. =item fread -fread() is C-specific--use read instead. +fread() is C-specific, see L instead. =item free -free() is C-specific. +free() is C-specific. Perl does memory management transparently. =item freopen -freopen() is C-specific--use open instead. +freopen() is C-specific, see L instead. =item frexp Return the mantissa and exponent of a floating-point number. - ($mantissa, $exponent) = POSIX::frexp( 3.14 ); + ($mantissa, $exponent) = POSIX::frexp( 1.234e56 ); =item fscanf -fscanf() is C-specific--use <> and regular expressions instead. +fscanf() is C-specific, use EE and regular expressions instead. =item fseek -Use method C instead. +Use method C instead, or see L. =item fsetpos -Use method C instead. +Use method C instead, or seek L. =item fstat @@ -397,174 +467,221 @@ Perl's builtin C function. =item ftell -Use method C instead. +Use method C instead, or see L. =item fwrite -fwrite() is C-specific--use print instead. +fwrite() is C-specific, see L instead. =item getc -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function, +see L. =item getchar -Returns one character from STDIN. +Returns one character from STDIN. Identical to Perl's C, +see L. =item getcwd Returns the name of the current working directory. +See also L. =item getegid -Returns the effective group id. +Returns the effective group identifier. Similar to Perl' s builtin +variable C<$(>, see L. =item getenv Returns the value of the specified enironment variable. +The same information is available through the C<%ENV> array. =item geteuid -Returns the effective user id. +Returns the effective user identifier. Identical to Perl's builtin C<$E> +variable, see L. =item getgid -Returns the user's real group id. +Returns the user's real group identifier. Similar to Perl's builtin +variable C<$)>, see L. =item getgrgid -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for +returning group entries by group identifiers, see +L. =item getgrnam -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for +returning group entries by group names, see L. =item getgroups -Returns the ids of the user's supplementary groups. +Returns the ids of the user's supplementary groups. Similar to Perl's +builtin variable C<$)>, see L. =item getlogin -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for +returning the user name associated with the current session, see +L. =item getpgrp -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for +returning the prcess group identifier of the current process, see +L. =item getpid -Returns the process's id. +Returns the process identifier. Identical to Perl's builtin +variable C<$$>, see L. =item getppid -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for +returning the process identifier of the parent process of the current +process , see L. =item getpwnam -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for +returning user entries by user names, see L. =item getpwuid -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for +returning user entries by user identifiers, see L. =item gets -Returns one line from STDIN. +Returns one line from C, similar to EE, also known +as the C function, see L. + +B: if you have C programs that still use C, be very +afraid. The C function is a source of endless grief because +it has no buffer overrun checks. It should B be used. The +C function should be preferred instead. =item getuid -Returns the user's id. +Returns the user's identifier. Identical to Perl's builtin C<$E> variable, +see L. =item gmtime -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for +converting seconds since the epoch to a date in Greenwich Mean Time, +see L. =item isalnum This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C construct instead, or possibly the C construct. =item isalpha This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C construct instead. =item isatty Returns a boolean indicating whether the specified filehandle is connected -to a tty. +to a tty. Similar to the C<-t> operator, see L. =item iscntrl This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C construct instead. =item isdigit This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C construct instead, or the C construct. =item isgraph This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C construct instead. =item islower This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C construct instead. Do B use C. =item isprint This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C construct instead. =item ispunct This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C construct instead. =item isspace This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C construct instead, or the C construct. =item isupper This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C construct instead. Do B use C. =item isxdigit This is identical to the C function, except that it can apply to a single -character or to a whole string. +character or to a whole string. Consider using regular expressions and the +C construct instead, or simply C. =item kill -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for sending +signals to processes (often to terminate them), see L. =item labs -labs() is C-specific, use abs instead. +(For returning absolute values of long integers.) +labs() is C-specific, see L instead. =item ldexp -This is identical to the C function C. +This is identical to the C function C +for multiplying floating point numbers with powers of two. + + $x_quadrupled = POSIX::ldexp($x, 2); =item ldiv -ldiv() is C-specific, use / and int instead. +(For computing dividends of long integers.) +ldiv() is C-specific, use C and C instead. =item link -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function +for creating hard links into files, see L. =item localeconv Get numeric formatting information. Returns a reference to a hash containing the current locale formatting values. -The database for the B (Deutsch or German) locale. +Here is how to query the database for the B (Deutsch or German) locale. $loc = POSIX::setlocale( &POSIX::LC_ALL, "de" ); print "Locale = $loc\n"; @@ -590,19 +707,34 @@ The database for the B (Deutsch or German) locale. =item localtime -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for +converting seconds since the epoch to a date see L. =item log -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function, +returning the natural (I-based) logarithm of the numerical argument, +see L. =item log10 -This is identical to the C function C. +This is identical to the C function C, +returning the 10-base logarithm of the numerical argument. +You can also use + + sub log10 { log($_[0]) / log(10) } + +or + + sub log10 { log($_[0]) / 2.30258509299405 } + +or + + sub log10 { log($_[0]) * 0.434294481903252 } =item longjmp -longjmp() is C-specific: use die instead. +longjmp() is C-specific: use L instead. =item lseek @@ -616,49 +748,63 @@ Returns C on failure. =item malloc -malloc() is C-specific. +malloc() is C-specific. Perl does memory management transparently. =item mblen This is identical to the C function C. +Perl does not have any support for the wide and multibyte +characters of the C standards, so this might be a rather +useless function. =item mbstowcs This is identical to the C function C. +Perl does not have any support for the wide and multibyte +characters of the C standards, so this might be a rather +useless function. =item mbtowc This is identical to the C function C. +Perl does not have any support for the wide and multibyte +characters of the C standards, so this might be a rather +useless function. =item memchr -memchr() is C-specific, use index() instead. +memchr() is C-specific, see L instead. =item memcmp -memcmp() is C-specific, use eq instead. +memcmp() is C-specific, use C instead, see L. =item memcpy -memcpy() is C-specific, use = instead. +memcpy() is C-specific, use C<=>, see L, or see L. =item memmove -memmove() is C-specific, use = instead. +memmove() is C-specific, use C<=>, see L, or see L. =item memset -memset() is C-specific, use x instead. +memset() is C-specific, use C instead, see L. =item mkdir -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function +for creating directories, see L. =item mkfifo -This is similar to the C function C. +This is similar to the C function C for creating +FIFO special files. -Returns C on failure. + if (mkfifo($path, $mode)) { .... + +Returns C on failure. The C<$mode> is similar to the +mode of C, see L. =item mktime @@ -689,13 +835,16 @@ Return the integral and fractional parts of a floating-point number. =item nice -This is similar to the C function C. +This is similar to the C function C, for changing +the scheduling preference of the current process. Positive +arguments mean more polite process, negative values more +needy process. Normal user processes can only be more polite. Returns C on failure. =item offsetof -offsetof() is C-specific. +offsetof() is C-specific, you probably want to see L instead. =item open @@ -720,6 +869,8 @@ Create a new file with mode 0640. Set up the file for writing. Returns C on failure. +See also L. + =item opendir Open a directory for reading. @@ -743,13 +894,17 @@ Returns C on failure. =item pause -This is similar to the C function C. +This is similar to the C function C, which suspends +the execution of the current process until a signal is received. Returns C on failure. =item perror -This is identical to the C function C. +This is identical to the C function C, which outputs to the +standard error stream the specified message followed by ": " and the +current error string. Use the C function and the C<$!> +variable instead, see L and L. =item pipe @@ -760,39 +915,45 @@ returned by C. POSIX::write( $fd0, "hello", 5 ); POSIX::read( $fd1, $buf, 5 ); +See also L. + =item pow -Computes $x raised to the power $exponent. +Computes C<$x> raised to the power C<$exponent>. $ret = POSIX::pow( $x, $exponent ); +You can also use the C<**> operator, see L. + =item printf -Prints the specified arguments to STDOUT. +Formats and prints the specified arguments to STDOUT. +See also L. =item putc -putc() is C-specific--use print instead. +putc() is C-specific, see L instead. =item putchar -putchar() is C-specific--use print instead. +putchar() is C-specific, see L instead. =item puts -puts() is C-specific--use print instead. +puts() is C-specific, see L instead. =item qsort -qsort() is C-specific, use sort instead. +qsort() is C-specific, see L instead. =item raise Sends the specified signal to the current process. +See also L and the C<$$> in L. =item rand -rand() is non-portable, use Perl's rand instead. +C is non-portable, see L instead. =item read @@ -805,21 +966,26 @@ read then Perl will extend it to make room for the request. Returns C on failure. +See also L. + =item readdir -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function +for reading directory entries, see L. =item realloc -realloc() is C-specific. +realloc() is C-specific. Perl does memory management transparently. =item remove -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function +for removing files, see L. =item rename -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function +for renaming files, see L. =item rewind @@ -827,23 +993,29 @@ Seeks to the beginning of the file. =item rewinddir -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function for +rewinding directory entry streams, see L. =item rmdir -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function +for removing (empty) directories, see L. =item scanf -scanf() is C-specific--use <> and regular expressions instead. +scanf() is C-specific, use EE and regular expressions instead, +see L. =item setgid -Sets the real group id for this process. +Sets the real group identifier for this process. +Identical to assigning a value to the Perl's builtin C<$)> variable, +see L. =item setjmp -setjmp() is C-specific: use eval {} instead. +C is C-specific: use C instead, +see L. =item setlocale @@ -879,17 +1051,21 @@ out which locales are available in your system. =item setpgid -This is similar to the C function C. +This is similar to the C function C for +setting the process group identifier of the current process. Returns C on failure. =item setsid -This is identical to the C function C. +This is identical to the C function C for +setting the session identifier of the current process. =item setuid -Sets the real user id for this process. +Sets the real user identifier for this process. +Identical to assigning a value to the Perl's builtin C<$E> variable, +see L. =item sigaction @@ -905,7 +1081,7 @@ Returns C on failure. =item siglongjmp -siglongjmp() is C-specific: use die instead. +siglongjmp() is C-specific: use L instead. =item sigpending @@ -933,7 +1109,8 @@ Returns C on failure. =item sigsetjmp -sigsetjmp() is C-specific: use eval {} instead. +C is C-specific: use C instead, +see L. =item sigsuspend @@ -949,63 +1126,80 @@ Returns C on failure. =item sin -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function +for returning the sine of the numerical argument, +see L. See also L. =item sinh -This is identical to the C function C. +This is identical to the C function C +for returning the hyperbolic sine of the numerical argument. +See also L. =item sleep -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function +for suspending the execution of the current for process +for certain number of seconds, see L. =item sprintf -This is identical to Perl's builtin C function. +This is similar to Perl's builtin C function +for returning a string that has the arguments formatted as requested, +see L. =item sqrt This is identical to Perl's builtin C function. +for returning the square root of the numerical argument, +see L. =item srand -srand(). +Give a seed the pseudorandom number generator, see L. =item sscanf -sscanf() is C-specific--use regular expressions instead. +sscanf() is C-specific, use regular expressions instead, +see L. =item stat -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function +for retutning information about files and directories. =item strcat -strcat() is C-specific, use .= instead. +strcat() is C-specific, use C<.=> instead, see L. =item strchr -strchr() is C-specific, use index() instead. +strchr() is C-specific, see L instead. =item strcmp -strcmp() is C-specific, use eq instead. +strcmp() is C-specific, use C or C instead, see L. =item strcoll -This is identical to the C function C. +This is identical to the C function C +for collating (comparing) strings transformed using +the C function. Not really needed since +Perl can do this transparently, see L. =item strcpy -strcpy() is C-specific, use = instead. +strcpy() is C-specific, use C<=> instead, see L. =item strcspn -strcspn() is C-specific, use regular expressions instead. +strcspn() is C-specific, use regular expressions instead, +see L. =item strerror Returns the error string for the specified errno. +Identical to the string form of the C<$!>, see L. =item strftime @@ -1034,39 +1228,38 @@ The string for Tuesday, December 12, 1995. =item strlen -strlen() is C-specific, use length instead. +strlen() is C-specific, use C instead, see L. =item strncat -strncat() is C-specific, use .= instead. +strncat() is C-specific, use C<.=> instead, see L. =item strncmp -strncmp() is C-specific, use eq instead. +strncmp() is C-specific, use C instead, see L. =item strncpy -strncpy() is C-specific, use = instead. - -=item stroul - -stroul() is C-specific. +strncpy() is C-specific, use C<=> instead, see L. =item strpbrk -strpbrk() is C-specific. +strpbrk() is C-specific, use regular expressions instead, +see L. =item strrchr -strrchr() is C-specific, use rindex() instead. +strrchr() is C-specific, see L instead. =item strspn -strspn() is C-specific. +strspn() is C-specific, use regular expressions instead, +see L. =item strstr -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function, +see L. =item strtod @@ -1093,7 +1286,8 @@ When called in a scalar context strtod returns the parsed number. =item strtok -strtok() is C-specific. +strtok() is C-specific, use regular expressions instead, see +L, or L. =item strtol @@ -1127,12 +1321,12 @@ When called in a scalar context strtol returns the parsed number. =item strtoul -String to unsigned (long) integer translation. strtoul is identical -to strtol except that strtoul only parses unsigned integers. See -I for details. +String to unsigned (long) integer translation. strtoul() is identical +to strtol() except that strtoul() only parses unsigned integers. See +L for details. -Note: Some vendors supply strtod and strtol but not strtoul. -Other vendors that do suply strtoul parse "-1" as a valid value. +Note: Some vendors supply strtod() and strtol() but not strtoul(). +Other vendors that do supply strtoul() parse "-1" as a valid value. =item strxfrm @@ -1140,6 +1334,11 @@ String transformation. Returns the transformed string. $dst = POSIX::strxfrm( $src ); +Used in conjunction with the C function, see L. + +Not really needed since Perl can do this transparently, see +L. + =item sysconf Retrieves values of system configurable variables. @@ -1152,53 +1351,66 @@ Returns C on failure. =item system -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function, see +L. =item tan -This is identical to the C function C. +This is identical to the C function C, returning the +tangent of the numerical argument. See also L. =item tanh -This is identical to the C function C. +This is identical to the C function C, returning the +hyperbolic tangent of the numerical argument. See also L. =item tcdrain -This is similar to the C function C. +This is similar to the C function C for draining +the output queue of its argument stream. Returns C on failure. =item tcflow -This is similar to the C function C. +This is similar to the C function C for controlling +the flow of its argument stream. Returns C on failure. =item tcflush -This is similar to the C function C. +This is similar to the C function C for flushing +the I/O buffers of its argumeny stream. Returns C on failure. =item tcgetpgrp -This is identical to the C function C. +This is identical to the C function C for returning the +process group identifier of the foreground process group of the controlling +terminal. =item tcsendbreak -This is similar to the C function C. +This is similar to the C function C for sending +a break on its argument stream. Returns C on failure. =item tcsetpgrp -This is similar to the C function C. +This is similar to the C function C for setting the +process group identifier of the foreground process group of the controlling +terminal. Returns C on failure. =item time -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function +for returning the number of seconds since the epoch +(whatever it is for the system), see L. =item times @@ -1214,7 +1426,7 @@ seconds. =item tmpfile -Use method C instead. +Use method C instead, or see L. =item tmpnam @@ -1222,17 +1434,28 @@ Returns a name for a temporary file. $tmpfile = POSIX::tmpnam(); +For security reasons, which are probably detailed in your system's +documentation for the C library tmpnam() function, this interface +should not be used; instead see L. + =item tolower -This is identical to Perl's builtin C function. +This is identical to the C function, except that it can apply to a single +character or to a whole string. Consider using the C function, +see L, or the equivalent C<\L> operator inside doublequotish +strings. =item toupper -This is identical to Perl's builtin C function. +This is identical to the C function, except that it can apply to a single +character or to a whole string. Consider using the C function, +see L, or the equivalent C<\U> operator inside doublequotish +strings. =item ttyname -This is identical to the C function C. +This is identical to the C function C for returning the +name of the current terminal. =item tzname @@ -1243,17 +1466,31 @@ Retrieves the time conversion information from the C variable. =item tzset -This is identical to the C function C. +This is identical to the C function C for setting +the current timezone based on the environment variable C, +to be used by C, C, C, and C +functions. =item umask -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function +for setting (and querying) the file creation permission mask, +see L. =item uname Get name of current operating system. - ($sysname, $nodename, $release, $version, $machine ) = POSIX::uname(); + ($sysname, $nodename, $release, $version, $machine) = POSIX::uname(); + +Note that the actual meanings of the various fields are not +that well standardized, do not expect any great portability. +The C<$sysname> might be the name of the operating system, +the C<$nodename> might be the name of the host, the C<$release> +might be the (major) release number of the operating system, +the C<$version> might be the (minor) release number of the +operating system, and the C<$machine> might be a hardware identifier. +Maybe. =item ungetc @@ -1261,32 +1498,36 @@ Use method C instead. =item unlink -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function +for removing files, see L. =item utime -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function +for changing the time stamps of files and directories, +see L. =item vfprintf -vfprintf() is C-specific. +vfprintf() is C-specific, see L instead. =item vprintf -vprintf() is C-specific. +vprintf() is C-specific, see L instead. =item vsprintf -vsprintf() is C-specific. +vsprintf() is C-specific, see L instead. =item wait -This is identical to Perl's builtin C function. +This is identical to Perl's builtin C function, +see L. =item waitpid Wait for a child process to change state. This is identical to Perl's -builtin C function. +builtin C function, see L. $pid = POSIX::waitpid( -1, &POSIX::WNOHANG ); print "status = ", ($? / 256), "\n"; @@ -1294,10 +1535,16 @@ builtin C function. =item wcstombs This is identical to the C function C. +Perl does not have any support for the wide and multibyte +characters of the C standards, so this might be a rather +useless function. =item wctomb This is identical to the C function C. +Perl does not have any support for the wide and multibyte +characters of the C standards, so this might be a rather +useless function. =item write @@ -1310,6 +1557,8 @@ calling C. Returns C on failure. +See also L. + =back =head1 CLASSES @@ -1715,7 +1964,7 @@ CLK_TCK CLOCKS_PER_SEC =item Constants -R_OK SEEK_CUR SEEK_END SEEK_SET STDIN_FILENO STDOUT_FILENO STRERR_FILENO W_OK X_OK +R_OK SEEK_CUR SEEK_END SEEK_SET STDIN_FILENO STDOUT_FILENO STDERR_FILENO W_OK X_OK =back @@ -1733,7 +1982,3 @@ WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG WIFSTOPPED WSTOPSIG =back -=head1 CREATION - -This document generated by ./mkposixman.PL version 19960129. - diff --git a/contrib/perl5/ext/POSIX/POSIX.xs b/contrib/perl5/ext/POSIX/POSIX.xs index 3a523d1d07a3..7ffd49411a5b 100644 --- a/contrib/perl5/ext/POSIX/POSIX.xs +++ b/contrib/perl5/ext/POSIX/POSIX.xs @@ -55,6 +55,9 @@ #ifdef I_UNISTD #include #endif +#ifdef MACOS_TRADITIONAL +#undef fdopen +#endif #include #if defined(__VMS) && !defined(__POSIX_SOURCE) @@ -80,7 +83,7 @@ /* The non-POSIX CRTL times() has void return type, so we just get the current time directly */ - clock_t vms_times(struct tms *PL_bufptr) { + clock_t vms_times(struct tms *bufptr) { dTHX; clock_t retval; /* Get wall time and convert to 10 ms intervals to @@ -101,7 +104,7 @@ _ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder)); # endif /* Fill in the struct tms using the CRTL routine . . .*/ - times((tbuffer_t *)PL_bufptr); + times((tbuffer_t *)bufptr); return (clock_t) retval; } # define times(t) vms_times(t) @@ -139,10 +142,12 @@ # define sigdelset(a,b) not_here("sigdelset") # define sigfillset(a) not_here("sigfillset") # define sigismember(a,b) not_here("sigismember") +# define setuid(a) not_here("setuid") +# define setgid(a) not_here("setgid") #else # ifndef HAS_MKFIFO -# ifdef OS2 +# if defined(OS2) || defined(MACOS_TRADITIONAL) # define mkfifo(a,b) not_here("mkfifo") # else /* !( defined OS2 ) */ # ifndef mkfifo @@ -151,12 +156,17 @@ # endif # endif /* !HAS_MKFIFO */ -# include -# include -# ifdef HAS_UNAME -# include +# ifdef MACOS_TRADITIONAL +# define ttyname(a) (char*)not_here("ttyname") +# define tzset() not_here("tzset") +# else +# include +# include +# ifdef HAS_UNAME +# include +# endif +# include # endif -# include # ifdef I_UTIME # include # endif @@ -529,12 +539,12 @@ mini_mktime(struct tm *ptm) } #ifdef HAS_LONG_DOUBLE -# if LONG_DOUBLESIZE > DOUBLESIZE +# if LONG_DOUBLESIZE > NVSIZE # undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */ # endif #endif -#ifndef HAS_LONG_DOUBLE +#ifndef HAS_LONG_DOUBLE #ifdef LDBL_MAX #undef LDBL_MAX #endif @@ -554,11 +564,7 @@ not_here(char *s) } static -#if defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE) -long double -#else -double -#endif +NV constant(char *name, int arg) { errno = 0; @@ -1517,6 +1523,11 @@ constant(char *name, int arg) break; case 'H': if (strEQ(name, "HUGE_VAL")) +#if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL) + /* HUGE_VALL is admittedly non-POSIX but if we are using long doubles + * we might as well use long doubles. --jhi */ + return HUGE_VALL; +#endif #ifdef HUGE_VAL return HUGE_VAL; #else @@ -2291,9 +2302,9 @@ constant(char *name, int arg) #else goto not_there; #endif - if (strEQ(name, "STRERR_FILENO")) -#ifdef STRERR_FILENO - return STRERR_FILENO; + if (strEQ(name, "STDERR_FILENO")) +#ifdef STDERR_FILENO + return STDERR_FILENO; #else goto not_there; #endif @@ -3005,7 +3016,7 @@ setcc(termios_ref, ccix, cc) MODULE = POSIX PACKAGE = POSIX -double +NV constant(name,arg) char * name int arg @@ -3161,7 +3172,7 @@ localeconv() #ifdef HAS_LOCALECONV struct lconv *lcbuf; RETVAL = newHV(); - if (lcbuf = localeconv()) { + if ((lcbuf = localeconv())) { /* the strings */ if (lcbuf->decimal_point && *lcbuf->decimal_point) hv_store(RETVAL, "decimal_point", 13, @@ -3294,73 +3305,73 @@ setlocale(category, locale = 0) RETVAL -double +NV acos(x) - double x + NV x -double +NV asin(x) - double x + NV x -double +NV atan(x) - double x + NV x -double +NV ceil(x) - double x + NV x -double +NV cosh(x) - double x + NV x -double +NV floor(x) - double x + NV x -double +NV fmod(x,y) - double x - double y + NV x + NV y void frexp(x) - double x + NV x PPCODE: int expvar; /* (We already know stack is long enough.) */ PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar)))); PUSHs(sv_2mortal(newSViv(expvar))); -double +NV ldexp(x,exp) - double x + NV x int exp -double +NV log10(x) - double x + NV x void modf(x) - double x + NV x PPCODE: - double intvar; + NV intvar; /* (We already know stack is long enough.) */ - PUSHs(sv_2mortal(newSVnv(modf(x,&intvar)))); + PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar)))); PUSHs(sv_2mortal(newSVnv(intvar))); -double +NV sinh(x) - double x + NV x -double +NV tan(x) - double x + NV x -double +NV tanh(x) - double x + NV x SysRet sigaction(sig, action, oldaction = 0) @@ -3406,9 +3417,8 @@ sigaction(sig, action, oldaction = 0) /* Set up any desired mask. */ svp = hv_fetch(action, "MASK", 4, FALSE); if (svp && sv_isa(*svp, "POSIX::SigSet")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(*svp)); - sigset = (sigset_t*) tmp; + IV tmp = SvIV((SV*)SvRV(*svp)); + sigset = INT2PTR(sigset_t*, tmp); act.sa_mask = *sigset; } else @@ -3433,9 +3443,8 @@ sigaction(sig, action, oldaction = 0) /* Get back the mask. */ svp = hv_fetch(oldaction, "MASK", 4, TRUE); if (sv_isa(*svp, "POSIX::SigSet")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(*svp)); - sigset = (sigset_t*) tmp; + IV tmp = SvIV((SV*)SvRV(*svp)); + sigset = INT2PTR(sigset_t*, tmp); } else { New(0, sigset, 1, sigset_t); @@ -3506,7 +3515,7 @@ SysRet nice(incr) int incr -int +void pipe() PPCODE: int fds[2]; @@ -3549,7 +3558,7 @@ tcsetpgrp(fd, pgrp_id) int fd pid_t pgrp_id -int +void uname() PPCODE: #ifdef HAS_UNAME @@ -3683,7 +3692,7 @@ strtoul(str, base = 0) PUSHs(&PL_sv_undef); } -SV * +void strxfrm(src) SV * src CODE: @@ -3818,7 +3827,10 @@ mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) OUTPUT: RETVAL -char * +#XXX: if $xsubpp::WantOptimize is always the default +# sv_setpv(TARG, ...) could be used rather than +# ST(0) = sv_2mortal(newSVpv(...)) +void strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1) char * fmt int sec diff --git a/contrib/perl5/ext/POSIX/typemap b/contrib/perl5/ext/POSIX/typemap index 63e41c77bf1f..baf9bfc05194 100644 --- a/contrib/perl5/ext/POSIX/typemap +++ b/contrib/perl5/ext/POSIX/typemap @@ -5,6 +5,7 @@ Time_t T_NV Gid_t T_NV Off_t T_NV Dev_t T_NV +NV T_NV fd T_IV speed_t T_IV tcflag_t T_IV diff --git a/contrib/perl5/ext/SDBM_File/SDBM_File.pm b/contrib/perl5/ext/SDBM_File/SDBM_File.pm index c5e26c8e04d8..ee82a54145d9 100644 --- a/contrib/perl5/ext/SDBM_File/SDBM_File.pm +++ b/contrib/perl5/ext/SDBM_File/SDBM_File.pm @@ -1,12 +1,13 @@ package SDBM_File; use strict; +use warnings; require Tie::Hash; use XSLoader (); our @ISA = qw(Tie::Hash); -our $VERSION = "1.02" ; +our $VERSION = "1.03" ; XSLoader::load 'SDBM_File', $VERSION; @@ -20,14 +21,96 @@ SDBM_File - Tied access to sdbm files =head1 SYNOPSIS + use Fcntl; # For O_RDWR, O_CREAT, etc. use SDBM_File; - tie(%h, 'SDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640); + tie(%h, 'SDBM_File', 'filename', O_RDWR|O_CREAT, 0666) + or die "Couldn't tie SDBM file 'filename': $!; aborting"; + + # Now read and change the hash + $h{newkey} = newvalue; + print $h{oldkey}; + ... untie %h; =head1 DESCRIPTION -See L, L +C establishes a connection between a Perl hash variable and +a file in SDBM_File format;. You can manipulate the data in the file +just as if it were in a Perl hash, but when your program exits, the +data will remain in the file, to be used the next time your program +runs. + +Use C with the Perl built-in C function to establish +the connection between the variable and the file. The arguments to +C should be: + +=over 4 + +=item 1. + +The hash variable you want to tie. + +=item 2. + +The string C<"SDBM_File">. (Ths tells Perl to use the C +package to perform the functions of the hash.) + +=item 3. + +The name of the file you want to tie to the hash. + +=item 4. + +Flags. Use one of: + +=over 2 + +=item C + +Read-only access to the data in the file. + +=item C + +Write-only access to the data in the file. + +=item C + +Both read and write access. + +=back + +If you want to create the file if it does not exist, add C to +any of these, as in the example. If you omit C and the file +does not already exist, the C call will fail. + +=item 5. + +The default permissions to use if a new file is created. The actual +permissions will be modified by the user's umask, so you should +probably use 0666 here. (See L.) + +=back + +=head1 DIAGNOSTICS + +On failure, the C call returns an undefined value and probably +sets C<$!> to contain the reason the file could not be tied. + +=head2 C + +This warning is emmitted when you try to store a key or a value that +is too long. It means that the change was not recorded in the +database. See BUGS AND WARNINGS below. + +=head1 BUGS AND WARNINGS + +There are a number of limits on the size of the data that you can +store in the SDBM file. The most important is that the length of a +key, plus the length of its associated value, may not exceed 1008 +bytes. + +See L, L, L =cut diff --git a/contrib/perl5/ext/SDBM_File/SDBM_File.xs b/contrib/perl5/ext/SDBM_File/SDBM_File.xs index a4b90451a9bc..859730bf3ac1 100644 --- a/contrib/perl5/ext/SDBM_File/SDBM_File.xs +++ b/contrib/perl5/ext/SDBM_File/SDBM_File.xs @@ -57,7 +57,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode) DBM * dbp ; RETVAL = NULL ; - if (dbp = sdbm_open(filename,flags,mode) ) { + if ((dbp = sdbm_open(filename,flags,mode))) { RETVAL = (SDBM_File)safemalloc(sizeof(SDBM_File_type)) ; Zero(RETVAL, 1, SDBM_File_type) ; RETVAL->dbp = dbp ; diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbm.c b/contrib/perl5/ext/SDBM_File/sdbm/dbm.c index dc47d7001dee..321ac3ef6061 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/dbm.c +++ b/contrib/perl5/ext/SDBM_File/sdbm/dbm.c @@ -3,16 +3,33 @@ * All rights reserved. * * Redistribution and use in source and binary forms are permitted - * provided that the above copyright notice and this paragraph are - * duplicated in all such forms and that any documentation, - * advertising materials, and other materials related to such - * distribution and use acknowledge that the software was developed - * by the University of California, Berkeley. The name of the - * University may not be used to endorse or promote products derived - * from this software without specific prior written permission. - * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR - * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. + * provided that the above copyright notice and this notice are + * duplicated in all such forms. + * + * [additional clause stricken -- see below] + * + * The name of the University may not be used to endorse or promote + * products derived from this software without specific prior written + * permission. THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY + * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR + * PURPOSE. + * + * This notice previously contained the additional clause: + * + * and that any documentation, advertising materials, and other + * materials related to such distribution and use acknowledge that + * the software was developed by the University of California, + * Berkeley. + * + * Pursuant to the licensing change made by the Office of Technology + * Licensing of the University of California, Berkeley on July 22, + * 1999 and documented in: + * + * ftp://ftp.cs.berkeley.edu/pub/4bsd/README.Impt.License.Change + * + * this clause has been stricken and no longer is applicable to this + * software. */ #ifndef lint diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbm.h b/contrib/perl5/ext/SDBM_File/sdbm/dbm.h index 1196953d9653..e2c935523899 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/dbm.h +++ b/contrib/perl5/ext/SDBM_File/sdbm/dbm.h @@ -3,16 +3,33 @@ * All rights reserved. * * Redistribution and use in source and binary forms are permitted - * provided that the above copyright notice and this paragraph are - * duplicated in all such forms and that any documentation, - * advertising materials, and other materials related to such - * distribution and use acknowledge that the software was developed - * by the University of California, Berkeley. The name of the - * University may not be used to endorse or promote products derived - * from this software without specific prior written permission. - * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR - * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. + * provided that the above copyright notice and this notice are + * duplicated in all such forms. + * + * [additional clause stricken -- see below] + * + * The name of the University may not be used to endorse or promote + * products derived from this software without specific prior written + * permission. THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY + * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR + * PURPOSE. + * + * This notice previously contained the additional clause: + * + * and that any documentation, advertising materials, and other + * materials related to such distribution and use acknowledge that + * the software was developed by the University of California, + * Berkeley. + * + * Pursuant to the licensing change made by the Office of Technology + * Licensing of the University of California, Berkeley on July 22, + * 1999 and documented in: + * + * ftp://ftp.cs.berkeley.edu/pub/4bsd/README.Impt.License.Change + * + * this clause has been stricken and no longer is applicable to this + * software. * * @(#)dbm.h 5.2 (Berkeley) 5/24/89 */ diff --git a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c index 64c75cbb2083..d41c770dfbcc 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c +++ b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c @@ -283,6 +283,10 @@ makroom(register DBM *db, long int hash, int need) { long newp; char twin[PBLKSIZ]; +#if defined(DOSISH) || defined(WIN32) + char zer[PBLKSIZ]; + long oldtail; +#endif char *pag = db->pagbuf; char *New = twin; register int smax = SPLTMAX; @@ -305,6 +309,23 @@ makroom(register DBM *db, long int hash, int need) * still looking at the page of interest. current page is not updated * here, as sdbm_store will do so, after it inserts the incoming pair. */ + +#if defined(DOSISH) || defined(WIN32) + /* + * Fill hole with 0 if made it. + * (hole is NOT read as 0) + */ + oldtail = lseek(db->pagf, 0L, SEEK_END); + memset(zer, 0, PBLKSIZ); + while (OFF_PAG(newp) > oldtail) { + if (lseek(db->pagf, 0L, SEEK_END) < 0 || + write(db->pagf, zer, PBLKSIZ) < 0) { + + return 0; + } + oldtail += PBLKSIZ; + } +#endif if (hash & (db->hmask + 1)) { if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) diff --git a/contrib/perl5/ext/SDBM_File/typemap b/contrib/perl5/ext/SDBM_File/typemap index eeb5d59027f5..40b95f22c022 100644 --- a/contrib/perl5/ext/SDBM_File/typemap +++ b/contrib/perl5/ext/SDBM_File/typemap @@ -20,8 +20,14 @@ T_DATUM_K $var.dsize = (int)PL_na; T_DATUM_V ckFilter($arg, filter_store_value, \"filter_store_value\"); - $var.dptr = SvPV($arg, PL_na); - $var.dsize = (int)PL_na; + if (SvOK($arg)) { + $var.dptr = SvPV($arg, PL_na); + $var.dsize = (int)PL_na; + } + else { + $var.dptr = \"\"; + $var.dsize = 0; + } T_GDATUM UNIMPLEMENTED OUTPUT diff --git a/contrib/perl5/ext/Socket/Socket.pm b/contrib/perl5/ext/Socket/Socket.pm index 02f098df77c9..d89b2f66b378 100644 --- a/contrib/perl5/ext/Socket/Socket.pm +++ b/contrib/perl5/ext/Socket/Socket.pm @@ -111,7 +111,7 @@ to inet_aton('255.255.255.255'). =item sockaddr_in SOCKADDR_IN -In an array context, unpacks its SOCKADDR_IN argument and returns an array +In a list context, unpacks its SOCKADDR_IN argument and returns an array consisting of (PORT, ADDRESS). In a scalar context, packs its (PORT, ADDRESS) arguments as a SOCKADDR_IN and returns it. If this is confusing, use pack_sockaddr_in() and unpack_sockaddr_in() explicitly. @@ -135,7 +135,7 @@ Will croak if the structure does not have AF_INET in the right place. =item sockaddr_un SOCKADDR_UN -In an array context, unpacks its SOCKADDR_UN argument and returns an array +In a list context, unpacks its SOCKADDR_UN argument and returns an array consisting of (PATHNAME). In a scalar context, packs its PATHNAME arguments as a SOCKADDR_UN and returns it. If this is confusing, use pack_sockaddr_un() and unpack_sockaddr_un() explicitly. @@ -268,6 +268,7 @@ use XSLoader (); SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR + SO_REUSEPORT SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO diff --git a/contrib/perl5/ext/Socket/Socket.xs b/contrib/perl5/ext/Socket/Socket.xs index 0584e785b529..e08982909b56 100644 --- a/contrib/perl5/ext/Socket/Socket.xs +++ b/contrib/perl5/ext/Socket/Socket.xs @@ -1006,12 +1006,15 @@ unpack_sockaddr_un(sun_sv) STRLEN sockaddrlen; char * sun_ad = SvPV(sun_sv,sockaddrlen); char * e; - +# ifndef __linux__ + /* On Linux sockaddrlen on sockets returned by accept, recvfrom, + getpeername and getsockname is not equal to sizeof(addr). */ if (sockaddrlen != sizeof(addr)) { croak("Bad arg length for %s, length is %d, should be %d", "Socket::unpack_sockaddr_un", sockaddrlen, sizeof(addr)); } +# endif Copy( sun_ad, &addr, sizeof addr, char ); diff --git a/contrib/perl5/ext/Sys/Syslog/Syslog.pm b/contrib/perl5/ext/Sys/Syslog/Syslog.pm index 2a91354e8792..92b82a1acdce 100644 --- a/contrib/perl5/ext/Sys/Syslog/Syslog.pm +++ b/contrib/perl5/ext/Sys/Syslog/Syslog.pm @@ -70,9 +70,11 @@ Sets the socket type to be used for the next call to C or C and returns TRUE on success, undef on failure. -A value of 'unix' will connect to the UNIX domain socket returned by -C<_PATH_LOG> in F. A value of 'inet' will connect to an -INET socket returned by getservbyname(). Any other value croaks. +A value of 'unix' will connect to the UNIX domain socket returned by the +C<_PATH_LOG> macro (if you system defines it) in F. A value of +'inet' will connect to an INET socket returned by getservbyname(). If +C<_PATH_LOG> is unavailable or if getservbyname() fails, returns undef. Any +other value croaks. The default is for the INET socket to be used. @@ -107,10 +109,15 @@ L =head1 AUTHOR -Tom Christiansen EFE and Larry Wall EFE. -UNIX domain sockets added by Sean Robinson EFE -with support from Tim Bunce and the perl5-porters mailing list. -Dependency on F replaced with XS code bu Tom Hughes EFE. +Tom Christiansen EFE and Larry Wall +EFE. + +UNIX domain sockets added by Sean Robinson +EFE with support from Tim Bunce +EFE and the perl5-porters mailing list. + +Dependency on F replaced with XS code by Tom Hughes +EFE. =cut @@ -159,7 +166,7 @@ sub setlogsock { local($setsock) = shift; &disconnect if $connected; if (lc($setsock) eq 'unix') { - if (defined &_PATH_LOG) { + if (length _PATH_LOG()) { $sock_type = 1; } else { return undef; @@ -244,9 +251,9 @@ sub syslog { else { if (open(CONS,">/dev/console")) { print CONS "<$facility.$priority>$whoami: $message\r"; - exit if defined $pid; # if fork failed, we're parent close CONS; } + exit if defined $pid; # if fork failed, we're parent } } } @@ -267,14 +274,15 @@ sub connect { ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _) } unless ( $sock_type ) { - my $udp = getprotobyname('udp'); - my $syslog = getservbyname('syslog','udp'); + my $udp = getprotobyname('udp') || croak "getprotobyname failed for udp"; + my $syslog = getservbyname('syslog','udp') || croak "getservbyname failed"; my $this = sockaddr_in($syslog, INADDR_ANY); my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host"); socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) || croak "socket: $!"; connect(SYSLOG,$that) || croak "connect: $!"; } else { - my $syslog = &_PATH_LOG || croak "_PATH_LOG not found in syslog.ph"; + my $syslog = _PATH_LOG(); + length($syslog) || croak "_PATH_LOG unavailable in syslog.h"; my $that = sockaddr_un($syslog) || croak "Can't locate $syslog"; socket(SYSLOG,AF_UNIX,SOCK_STREAM,0) || croak "socket: $!"; if (!connect(SYSLOG,$that)) { diff --git a/contrib/perl5/ext/Sys/Syslog/Syslog.xs b/contrib/perl5/ext/Sys/Syslog/Syslog.xs index f0573b8109aa..31c0e845a2de 100644 --- a/contrib/perl5/ext/Sys/Syslog/Syslog.xs +++ b/contrib/perl5/ext/Sys/Syslog/Syslog.xs @@ -550,8 +550,7 @@ _PATH_LOG() #ifdef _PATH_LOG RETVAL = _PATH_LOG; #else - croak("Your vendor has not defined the Sys::Syslog macro _PATH_LOG"); - RETVAL = NULL; + RETVAL = ""; #endif OUTPUT: RETVAL diff --git a/contrib/perl5/ext/Thread/Thread.pm b/contrib/perl5/ext/Thread/Thread.pm index 00cba8af6736..23f9fe513845 100644 --- a/contrib/perl5/ext/Thread/Thread.pm +++ b/contrib/perl5/ext/Thread/Thread.pm @@ -12,6 +12,15 @@ $VERSION = "1.0"; Thread - manipulate threads in Perl (EXPERIMENTAL, subject to change) +=head1 CAVEAT + +The Thread extension requires Perl to be built in a particular way to +enable the older 5.005 threading model. Just to confuse matters, there +is an alternate threading model known as "ithreads" that does NOT +support this extension. If you are using a binary distribution such +as ActivePerl that is built with ithreads support, this extension CANNOT +be used. + =head1 SYNOPSIS use Thread; @@ -130,7 +139,7 @@ signal is discarded. =item cond_broadcast VARIABLE -The C function works similarly to C. +The C function works similarly to C. C, though, will unblock B the threads that are blocked in a C on the locked variable, rather than only one. diff --git a/contrib/perl5/ext/Thread/Thread.xs b/contrib/perl5/ext/Thread/Thread.xs index 4b5e6db9f869..15e2aa27c3ad 100644 --- a/contrib/perl5/ext/Thread/Thread.xs +++ b/contrib/perl5/ext/Thread/Thread.xs @@ -21,7 +21,7 @@ static int sig_pipe[2]; #endif static void -remove_thread(pTHX_ struct perl_thread *t) +remove_thread(pTHX_ Thread t) { #ifdef USE_THREADS DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log, @@ -82,7 +82,7 @@ threadstart(void *arg) #else Thread thr = (Thread) arg; LOGOP myop; - djSP; + dSP; I32 oldmark = TOPMARK; I32 oldscope = PL_scopestack_ix; I32 retval; @@ -98,7 +98,6 @@ threadstart(void *arg) DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p waiting to start\n", thr)); - /* Don't call *anything* requiring dTHR until after PERL_SET_THX() */ /* * Wait until our creator releases us. If we didn't do this, then * it would be potentially possible for out thread to carry on and @@ -116,7 +115,6 @@ threadstart(void *arg) */ PERL_SET_THX(thr); - /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */ DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p starting at %s\n", thr, SvPEEK(TOPs))); @@ -323,7 +321,13 @@ newthread (pTHX_ SV *startsv, AV *initargs, char *classname) return sv; #else - croak("No threads in this perl"); +# ifdef USE_ITHREADS + croak("This perl was built for \"ithreads\", which currently does not support Thread.pm.\n" + "Run \"perldoc Thread\" for more information"); +# else + croak("This perl was not built with support for 5.005-style threads.\n" + "Run \"perldoc Thread\" for more information"); +# endif return &PL_sv_undef; #endif } diff --git a/contrib/perl5/ext/re/Makefile.PL b/contrib/perl5/ext/re/Makefile.PL index bd0f1f741c19..bc31b2c2cc6d 100644 --- a/contrib/perl5/ext/re/Makefile.PL +++ b/contrib/perl5/ext/re/Makefile.PL @@ -1,4 +1,6 @@ use ExtUtils::MakeMaker; +use File::Spec; + WriteMakefile( NAME => 're', VERSION_FROM => 're.pm', @@ -9,33 +11,28 @@ WriteMakefile( clean => { FILES => '*$(OBJ_EXT) *.c ../../lib/re.pm' }, ); -sub MY::postamble { - if ($^O eq 'VMS') { - return <<'VMS_EOF'; -re_comp.c : [--]regcomp.c - - $(RM_F) $(MMS$TARGET_NAME) - $(CP) [--]regcomp.c $(MMS$TARGET_NAME) +package MY; -re_comp$(OBJ_EXT) : re_comp.c +sub upupfile { + File::Spec->catfile(File::Spec->updir, File::Spec->updir, $_[0]); +} -re_exec.c : [--]regexec.c - - $(RM_F) $(MMS$TARGET_NAME) - $(CP) [--]regexec.c $(MMS$TARGET_NAME) +sub postamble { + my $regcomp_c = upupfile('regcomp.c'); + my $regexec_c = upupfile('regexec.c'); -re_exec$(OBJ_EXT) : re_exec.c + < SVt_NULL; char *proto = (doproto && SvPOK(gv)) ? SvPVX(gv) : NULL; @@ -106,7 +104,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : ""; GvCVGEN(gv) = 0; GvEGV(gv) = gv; - sv_magic((SV*)gv, (SV*)gv, '*', name, len); + sv_magic((SV*)gv, (SV*)gv, '*', Nullch, 0); GvSTASH(gv) = (HV*)SvREFCNT_inc(stash); GvNAME(gv) = savepvn(name, len); GvNAMELEN(gv) = len; @@ -121,7 +119,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) LEAVE; PL_sub_generation++; - CvGV(GvCV(gv)) = (GV*)SvREFCNT_inc(gv); + CvGV(GvCV(gv)) = gv; CvFILE(GvCV(gv)) = CopFILE(PL_curcop); CvSTASH(GvCV(gv)) = PL_curstash; #ifdef USE_THREADS @@ -159,18 +157,18 @@ S_gv_init_sv(pTHX_ GV *gv, I32 sv_type) Returns the glob with the given C and a defined subroutine or C. The glob lives in the given C, or in the stashes -accessible via @ISA and @UNIVERSAL. +accessible via @ISA and @UNIVERSAL. The argument C should be either 0 or -1. If C, as a side-effect creates a glob with the given C in the given C which in the case of success contains an alias for the subroutine, and sets -up caching info for this glob. Similarly for all the searched stashes. +up caching info for this glob. Similarly for all the searched stashes. This function grants C<"SUPER"> token as a postfix of the stash name. The GV returned from C may be a method cache entry, which is not visible to Perl code. So when calling C, you should not use the GV directly; instead, you should use the method's CV, which can be -obtained from the GV with the C macro. +obtained from the GV with the C macro. =cut */ @@ -227,7 +225,6 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) basestash = gv_stashpvn(packname, packlen, TRUE); gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE); if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) { - dTHR; /* just for SvREFCNT_dec */ gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE); if (!gvp || !(gv = *gvp)) Perl_croak(aTHX_ "Cannot create %s::ISA", HvNAME(stash)); @@ -247,7 +244,6 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) SV* sv = *svp++; HV* basestash = gv_stashsv(sv, FALSE); if (!basestash) { - dTHR; /* just for ckWARN */ if (ckWARN(WARN_MISC)) Perl_warner(aTHX_ WARN_MISC, "Can't locate package %s for @%s::ISA", SvPVX(sv), HvNAME(stash)); @@ -317,24 +313,24 @@ Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name) Returns the glob which contains the subroutine to call to invoke the method on the C. In fact in the presence of autoloading this may be the glob for "AUTOLOAD". In this case the corresponding variable $AUTOLOAD is -already setup. +already setup. The third parameter of C determines whether AUTOLOAD lookup is performed if the given method is not present: non-zero -means yes, look for AUTOLOAD; zero means no, don't look for AUTOLOAD. +means yes, look for AUTOLOAD; zero means no, don't look for AUTOLOAD. Calling C is equivalent to calling C -with a non-zero C parameter. +with a non-zero C parameter. These functions grant C<"SUPER"> token as a prefix of the method name. Note that if you want to keep the returned glob for a long time, you need to check for it being "AUTOLOAD", since at the later time the call may load a different subroutine due to $AUTOLOAD changing its value. Use the glob -created via a side effect to do this. +created via a side effect to do this. These functions have the same side-effects and as C with C. C should be writable if contains C<':'> or C<' ''>. The warning against passing the GV returned by C to -C apply equally to these functions. +C apply equally to these functions. =cut */ @@ -342,11 +338,10 @@ C apply equally to these functions. GV * Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) { - dTHR; register const char *nend; const char *nsplit = 0; GV* gv; - + for (nend = name; *nend; nend++) { if (*nend == '\'') nsplit = nend; @@ -372,7 +367,7 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) gv = gv_fetchmeth(stash, name, nend - name, 0); if (!gv) { - if (strEQ(name,"import")) + if (strEQ(name,"import") || strEQ(name,"unimport")) gv = (GV*)&PL_sv_yes; else if (autoload) gv = gv_autoload4(stash, name, nend - name, TRUE); @@ -403,7 +398,6 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) GV* Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) { - dTHR; static char autoload[] = "AUTOLOAD"; static STRLEN autolen = 8; GV* gv; @@ -418,10 +412,13 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) return Nullgv; cv = GvCV(gv); + if (!CvROOT(cv)) + return Nullgv; + /* * Inheriting AUTOLOAD for non-methods works ... for now. */ - if (ckWARN(WARN_DEPRECATED) && !method && + if (ckWARN(WARN_DEPRECATED) && !method && (GvCVGEN(gv) || GvSTASH(gv) != stash)) Perl_warner(aTHX_ WARN_DEPRECATED, "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated", @@ -435,9 +432,18 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) */ varstash = GvSTASH(CvGV(cv)); vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE); + ENTER; + +#ifdef USE_THREADS + sv_lock((SV *)varstash); +#endif if (!isGV(vargv)) gv_init(vargv, varstash, autoload, autolen, FALSE); + LEAVE; varsv = GvSV(vargv); +#ifdef USE_THREADS + sv_lock(varsv); +#endif sv_setpv(varsv, HvNAME(stash)); sv_catpvn(varsv, "::", 2); sv_catpvn(varsv, name, len); @@ -513,14 +519,12 @@ Perl_gv_stashsv(pTHX_ SV *sv, I32 create) GV * Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) { - dTHR; register const char *name = nambeg; register GV *gv = 0; GV**gvp; I32 len; register const char *namend; HV *stash = 0; - U32 add_gvflags = 0; if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */ name++; @@ -653,8 +657,10 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) : sv_type == SVt_PVAV ? "@" : sv_type == SVt_PVHV ? "%" : ""), name)); + stash = PL_nullstash; } - return Nullgv; + else + return Nullgv; } if (!SvREFCNT(stash)) /* symbol table under destruction */ @@ -680,9 +686,9 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) Perl_warner(aTHX_ WARN_INTERNAL, "Had to create %s unexpectedly", nambeg); gv_init(gv, stash, name, len, add & GV_ADDMULTI); gv_init_sv(gv, sv_type); - GvFLAGS(gv) |= add_gvflags; - if (isLEXWARN_on && isALPHA(name[0]) && ! ckWARN(WARN_ONCE)) + if (isALPHA(name[0]) && ! (isLEXWARN_on ? ckWARN(WARN_ONCE) + : (PL_dowarn & G_WARN_ON ) ) ) GvMULTI_on(gv) ; /* set up magic where warranted */ @@ -723,7 +729,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) if (strEQ(name, "OVERLOAD")) { HV* hv = GvHVn(gv); GvMULTI_on(gv); - hv_magic(hv, gv, 'A'); + hv_magic(hv, Nullgv, 'A'); } break; case 'S': @@ -737,7 +743,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) } GvMULTI_on(gv); hv = GvHVn(gv); - hv_magic(hv, gv, 'S'); + hv_magic(hv, Nullgv, 'S'); for (i = 1; PL_sig_name[i]; i++) { SV ** init; init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1); @@ -807,6 +813,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) else { AV* av = GvAVn(gv); sv_magic((SV*)av, Nullsv, 'D', Nullch, 0); + SvREADONLY_on(av); } goto magicalize; case '#': @@ -827,7 +834,6 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) case ',': case '\\': case '/': - case '|': case '\001': /* $^A */ case '\003': /* $^C */ case '\004': /* $^D */ @@ -841,6 +847,11 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) if (len > 1) break; goto magicalize; + case '|': + if (len > 1) + break; + sv_setiv(GvSV(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0); + goto magicalize; case '\023': /* $^S */ if (len > 1) break; @@ -857,6 +868,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) else { AV* av = GvAVn(gv); sv_magic((SV*)av, (SV*)av, 'D', Nullch, 0); + SvREADONLY_on(av); } /* FALL THROUGH */ case '1': @@ -889,9 +901,16 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) if (len == 1) { SV *sv = GvSV(gv); (void)SvUPGRADE(sv, SVt_PVNV); + Perl_sv_setpvf(aTHX_ sv, +#if defined(PERL_SUBVERSION) && (PERL_SUBVERSION > 0) + "%8.6" +#else + "%5.3" +#endif + NVff, + SvNVX(PL_patchlevel)); SvNVX(sv) = SvNVX(PL_patchlevel); SvNOK_on(sv); - (void)SvPV_nolen(sv); SvREADONLY_on(sv); } break; @@ -906,6 +925,22 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) return gv; } +void +Perl_gv_fullname4(pTHX_ SV *sv, GV *gv, const char *prefix, bool keepmain) +{ + HV *hv = GvSTASH(gv); + if (!hv) { + (void)SvOK_off(sv); + return; + } + sv_setpv(sv, prefix ? prefix : ""); + if (keepmain || strNE(HvNAME(hv), "main")) { + sv_catpv(sv,HvNAME(hv)); + sv_catpvn(sv,"::", 2); + } + sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv)); +} + void Perl_gv_fullname3(pTHX_ SV *sv, GV *gv, const char *prefix) { @@ -920,6 +955,15 @@ Perl_gv_fullname3(pTHX_ SV *sv, GV *gv, const char *prefix) sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv)); } +void +Perl_gv_efullname4(pTHX_ SV *sv, GV *gv, const char *prefix, bool keepmain) +{ + GV *egv = GvEGV(gv); + if (!egv) + egv = gv; + gv_fullname4(sv, egv, prefix, keepmain); +} + void Perl_gv_efullname3(pTHX_ SV *sv, GV *gv, const char *prefix) { @@ -946,7 +990,6 @@ Perl_gv_efullname(pTHX_ SV *sv, GV *gv) IO * Perl_newIO(pTHX) { - dTHR; IO *io; GV *iogv; @@ -965,7 +1008,6 @@ Perl_newIO(pTHX) void Perl_gv_check(pTHX_ HV *stash) { - dTHR; register HE *entry; register I32 i; register GV *gv; @@ -1042,7 +1084,6 @@ Perl_gp_ref(pTHX_ GP *gp) void Perl_gp_free(pTHX_ GV *gv) { - dTHR; GP* gp; if (!gv || !(gp = GvGP(gv))) @@ -1082,7 +1123,7 @@ Perl_gp_free(pTHX_ GV *gv) AV *GvAVn(gv) register GV *gv; { - if (GvGP(gv)->gp_av) + if (GvGP(gv)->gp_av) return GvGP(gv)->gp_av; else return GvGP(gv_AVadd(gv))->gp_av; @@ -1103,7 +1144,6 @@ register GV *gv; bool Perl_Gv_AMupdate(pTHX_ HV *stash) { - dTHR; GV* gv; CV* cv; MAGIC* mg=mg_find((SV*)stash,'c'); @@ -1154,7 +1194,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) for (i = 1; i < NofAMmeth; i++) { cv = 0; cp = (char *)PL_AMG_names[i]; - + svp = (SV**)hv_fetch(hv, cp, strlen(cp), FALSE); if (svp && ((sv = *svp) != &PL_sv_undef)) { switch (SvTYPE(sv)) { @@ -1224,19 +1264,19 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) /* GvSV contains the name of the method. */ GV *ngv; - DEBUG_o( Perl_deb(aTHX_ "Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", + DEBUG_o( Perl_deb(aTHX_ "Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) ); - if (!SvPOK(GvSV(gv)) + if (!SvPOK(GvSV(gv)) || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)), FALSE))) { /* Can be an import stub (created by `can'). */ if (GvCVGEN(gv)) { - Perl_croak(aTHX_ "Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'", + Perl_croak(aTHX_ "Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'", (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ), cp, HvNAME(stash)); } else - Perl_croak(aTHX_ "Can't resolve method `%.256s' overloading `%s' in package `%.256s'", + Perl_croak(aTHX_ "Can't resolve method `%.256s' overloading `%s' in package `%.256s'", (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ), cp, HvNAME(stash)); } @@ -1247,7 +1287,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) GvNAME(CvGV(cv))) ); filled = 1; } -#endif +#endif amt.table[i]=(CV*)SvREFCNT_inc(cv); } if (filled) { @@ -1266,9 +1306,8 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) SV* Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) { - dTHR; - MAGIC *mg; - CV *cv; + MAGIC *mg; + CV *cv; CV **cvp=NULL, **ocvp=NULL; AMT *amtp, *oamtp; int fl=0, off, off1, lr=0, assign=AMGf_assign & flags, notfound=0; @@ -1276,10 +1315,10 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) HV* stash; if (!(AMGf_noleft & flags) && SvAMAGIC(left) && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c')) - && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) + && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table : (CV **) NULL)) - && ((cv = cvp[off=method+assignshift]) + && ((cv = cvp[off=method+assignshift]) || (assign && amtp->fallback > AMGfallNEVER && /* fallback to * usual method */ (fl = 1, cv = cvp[off=method])))) { @@ -1315,7 +1354,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=bool__amg])); break; case not_amg: - (void)((cv = cvp[off=bool__amg]) + (void)((cv = cvp[off=bool__amg]) || (cv = cvp[off=numer_amg]) || (cv = cvp[off=string_amg])); postpr = 1; @@ -1340,7 +1379,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } break; case abs_amg: - if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg]) + if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg]) && ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) { SV* nullsv=sv_2mortal(newSViv(0)); if (off1==lt_amg) { @@ -1371,13 +1410,16 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } break; case iter_amg: /* XXXX Eventually should do to_gv. */ + /* FAIL safe */ + return NULL; /* Delegate operation to standard mechanisms. */ + break; case to_sv_amg: case to_av_amg: case to_hv_amg: case to_gv_amg: case to_cv_amg: /* FAIL safe */ - return NULL; /* Delegate operation to standard mechanisms. */ + return left; /* Delegate operation to standard mechanisms. */ break; default: goto not_found; @@ -1385,14 +1427,14 @@ 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))),'c')) - && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) + && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (amtp = (AMT*)mg->mg_ptr)->table : (CV **) NULL)) && (cv = cvp[off=method])) { /* Method for right * argument found */ lr=1; - } else if (((ocvp && oamtp->fallback > AMGfallNEVER - && (cvp=ocvp) && (lr = -1)) + } else if (((ocvp && oamtp->fallback > AMGfallNEVER + && (cvp=ocvp) && (lr = -1)) || (cvp && amtp->fallback > AMGfallNEVER && (lr=1))) && !(flags & AMGf_unary)) { /* We look for substitution for @@ -1425,6 +1467,16 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } } else { not_found: /* No method found, either report or croak */ + switch (method) { + case to_sv_amg: + case to_av_amg: + case to_hv_amg: + case to_gv_amg: + case to_cv_amg: + /* FAIL safe */ + return left; /* Delegate operation to standard mechanisms. */ + break; + } if (ocvp && (cv=ocvp[nomethod_amg])) { /* Call report method */ notfound = 1; lr = -1; } else if (cvp && (cv=cvp[nomethod_amg])) { @@ -1432,22 +1484,22 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } else { SV *msg; if (off==-1) off=method; - msg = sv_2mortal(Perl_newSVpvf(aTHX_ + msg = sv_2mortal(Perl_newSVpvf(aTHX_ "Operation `%s': no method found,%sargument %s%s%s%s", PL_AMG_names[method + assignshift], (flags & AMGf_unary ? " " : "\n\tleft "), - SvAMAGIC(left)? + SvAMAGIC(left)? "in overloaded package ": "has no overloaded magic", - SvAMAGIC(left)? + SvAMAGIC(left)? HvNAME(SvSTASH(SvRV(left))): "", - SvAMAGIC(right)? + SvAMAGIC(right)? ",\n\tright argument in overloaded package ": - (flags & AMGf_unary + (flags & AMGf_unary ? "" : ",\n\tright argument has no overloaded magic"), - SvAMAGIC(right)? + SvAMAGIC(right)? HvNAME(SvSTASH(SvRV(right))): "")); if (amtp && amtp->fallback >= AMGfallYES) { @@ -1461,7 +1513,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } } if (!notfound) { - DEBUG_o( Perl_deb(aTHX_ + DEBUG_o( Perl_deb(aTHX_ "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n", PL_AMG_names[off], method+assignshift==off? "" : @@ -1472,7 +1524,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), + HvNAME(stash), fl? ",\n\tassignment variant used": "") ); } /* Since we use shallow copy during assignment, we need @@ -1485,10 +1537,10 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) * b) Increment or decrement, called directly. * assignshift==0, assign==0, method + 0 == off * c) Increment or decrement, translated to assignment add/subtr. - * assignshift==0, assign==T, + * assignshift==0, assign==T, * force_cpy == T * d) Increment or decrement, translated to nomethod. - * assignshift==0, assign==0, + * assignshift==0, assign==0, * force_cpy == T * e) Assignment form translated to nomethod. * assignshift==1, assign==T, method + 1 != off @@ -1580,3 +1632,110 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } } } + +/* +=for apidoc is_gv_magical + +Returns C if given the name of a magical GV. + +Currently only useful internally when determining if a GV should be +created even in rvalue contexts. + +C is not used at present but available for future extension to +allow selecting particular classes of magical variable. + +=cut +*/ +bool +Perl_is_gv_magical(pTHX_ char *name, STRLEN len, U32 flags) +{ + if (!len) + return FALSE; + + switch (*name) { + case 'I': + if (len == 3 && strEQ(name, "ISA")) + goto yes; + break; + case 'O': + if (len == 8 && strEQ(name, "OVERLOAD")) + goto yes; + break; + case 'S': + if (len == 3 && strEQ(name, "SIG")) + goto yes; + break; + case '\027': /* $^W & $^WARNING_BITS */ + if (len == 1 + || (len == 12 && strEQ(name, "\027ARNING_BITS")) + || (len == 17 && strEQ(name, "\027IDE_SYSTEM_CALLS"))) + { + goto yes; + } + break; + + case '&': + case '`': + case '\'': + case ':': + case '?': + case '!': + case '-': + case '#': + case '*': + case '[': + case '^': + case '~': + case '=': + case '%': + case '.': + case '(': + case ')': + case '<': + case '>': + case ',': + case '\\': + case '/': + case '|': + case '+': + case ';': + case ']': + case '\001': /* $^A */ + case '\003': /* $^C */ + case '\004': /* $^D */ + case '\005': /* $^E */ + case '\006': /* $^F */ + case '\010': /* $^H */ + case '\011': /* $^I, NOT \t in EBCDIC */ + case '\014': /* $^L */ + case '\017': /* $^O */ + case '\020': /* $^P */ + case '\023': /* $^S */ + case '\024': /* $^T */ + case '\026': /* $^V */ + if (len == 1) + goto yes; + break; + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + if (len > 1) { + char *end = name + len; + while (--end > name) { + if (!isDIGIT(*end)) + return FALSE; + } + } + yes: + return TRUE; + default: + break; + } + return FALSE; +} diff --git a/contrib/perl5/gv.h b/contrib/perl5/gv.h index d2234a69b47b..07a04b67cb6f 100644 --- a/contrib/perl5/gv.h +++ b/contrib/perl5/gv.h @@ -1,6 +1,6 @@ /* gv.h * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. diff --git a/contrib/perl5/handy.h b/contrib/perl5/handy.h index 2c5d706de48f..d71d84a2f51d 100644 --- a/contrib/perl5/handy.h +++ b/contrib/perl5/handy.h @@ -1,6 +1,6 @@ /* handy.h * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -48,10 +48,10 @@ Null SV pointer. just figure out all the headers such a test needs. Andy Dougherty August 1996 */ -/* bool is built-in for g++-2.6.3 and later, which might be used +/* bool is built-in for g++-2.6.3 and later, which might be used for extensions. <_G_config.h> defines _G_HAVE_BOOL, but we can't be sure _G_config.h will be included before this file. _G_config.h - also defines _G_HAVE_BOOL for both gcc and g++, but only g++ + also defines _G_HAVE_BOOL for both gcc and g++, but only g++ actually has bool. Hence, _G_HAVE_BOOL is pretty useless for us. g++ can be identified by __GNUG__. Andy Dougherty February 2000 @@ -101,8 +101,8 @@ Null SV pointer. Similarly, there is no guarantee that I16 and U16 have exactly 16 bits. - For dealing with issues that may arise from various 32/64-bit - systems, we will ask Configure to check out + For dealing with issues that may arise from various 32/64-bit + systems, we will ask Configure to check out SHORTSIZE == sizeof(short) INTSIZE == sizeof(int) @@ -114,6 +114,10 @@ Null SV pointer. */ +#ifdef I_INTTYPES /* e.g. Linux has int64_t without */ +# include +#endif + typedef I8TYPE I8; typedef U8TYPE U8; typedef I16TYPE I16; @@ -122,17 +126,28 @@ typedef I32TYPE I32; typedef U32TYPE U32; #ifdef PERL_CORE # ifdef HAS_QUAD -# if QUADKIND == QUAD_IS_INT64_T -# include -# ifdef I_INTTYPES /* e.g. Linux has int64_t without */ -# include -# endif -# endif typedef I64TYPE I64; typedef U64TYPE U64; # endif #endif /* PERL_CORE */ +#if defined(HAS_QUAD) && defined(USE_64_BIT_INT) +# ifndef UINT64_C /* usually from */ +# if defined(HAS_LONG_LONG) && QUADKIND == QUAD_IS_LONG_LONG +# define INT64_C(c) CAT2(c,LL) +# define UINT64_C(c) CAT2(c,ULL) +# else +# if LONGSIZE == 8 && QUADKIND == QUAD_IS_LONG +# define INT64_C(c) CAT2(c,L) +# define UINT64_C(c) CAT2(c,UL) +# else +# define INT64_C(c) ((I64TYPE)(c)) +# define UINT64_C(c) ((U64TYPE)(c)) +# endif +# endif +# endif +#endif + /* Mention I8SIZE, U8SIZE, I16SIZE, U16SIZE, I32SIZE, U32SIZE, I64SIZE, and U64SIZE here so that metaconfig pulls them in. */ @@ -260,18 +275,18 @@ C). /* =for apidoc Am|bool|isALNUM|char ch -Returns a boolean indicating whether the C C is an ascii alphanumeric -character or digit. +Returns a boolean indicating whether the C C is an ASCII alphanumeric +character (including underscore) or digit. =for apidoc Am|bool|isALPHA|char ch -Returns a boolean indicating whether the C C is an ascii alphabetic +Returns a boolean indicating whether the C C is an ASCII alphabetic character. =for apidoc Am|bool|isSPACE|char ch Returns a boolean indicating whether the C C is whitespace. =for apidoc Am|bool|isDIGIT|char ch -Returns a boolean indicating whether the C C is an ascii +Returns a boolean indicating whether the C C is an ASCII digit. =for apidoc Am|bool|isUPPER|char ch @@ -296,6 +311,8 @@ Converts the specified character to lowercase. #define isALPHA(c) (isUPPER(c) || isLOWER(c)) #define isSPACE(c) \ ((c) == ' ' || (c) == '\t' || (c) == '\n' || (c) =='\r' || (c) == '\f') +#define isPSXSPC(c) (isSPACE(c) || (c) == '\v') +#define isBLANK(c) ((c) == ' ' || (c) == '\t') #define isDIGIT(c) ((c) >= '0' && (c) <= '9') #ifdef EBCDIC /* In EBCDIC we do not do locales: therefore() isupper() is fine. */ @@ -382,6 +399,9 @@ Converts the specified character to lowercase. # endif #endif /* USE_NEXT_CTYPE */ +#define isPSXSPC_LC(c) (isSPACE_LC(c) || (c) == '\v') +#define isBLANK_LC(c) isBLANK(c) /* could be wrong */ + #define isALNUM_uni(c) is_uni_alnum(c) #define isIDFIRST_uni(c) is_uni_idfirst(c) #define isALPHA_uni(c) is_uni_alpha(c) @@ -400,6 +420,9 @@ Converts the specified character to lowercase. #define toTITLE_uni(c) to_uni_title(c) #define toLOWER_uni(c) to_uni_lower(c) +#define isPSXSPC_uni(c) (isSPACE_uni(c) ||(c) == '\f') +#define isBLANK_uni(c) isBLANK(c) /* could be wrong */ + #define isALNUM_LC_uni(c) (c < 256 ? isALNUM_LC(c) : is_uni_alnum_lc(c)) #define isIDFIRST_LC_uni(c) (c < 256 ? isIDFIRST_LC(c) : is_uni_idfirst_lc(c)) #define isALPHA_LC_uni(c) (c < 256 ? isALPHA_LC(c) : is_uni_alpha_lc(c)) @@ -416,6 +439,9 @@ Converts the specified character to lowercase. #define toTITLE_LC_uni(c) (c < 256 ? toUPPER_LC(c) : to_uni_title_lc(c)) #define toLOWER_LC_uni(c) (c < 256 ? toLOWER_LC(c) : to_uni_lower_lc(c)) +#define isPSXSPC_LC_uni(c) (isSPACE_LC_uni(c) ||(c) == '\f') +#define isBLANK_LC_uni(c) isBLANK(c) /* could be wrong */ + #define isALNUM_utf8(p) is_utf8_alnum(p) #define isIDFIRST_utf8(p) is_utf8_idfirst(p) #define isALPHA_utf8(p) is_utf8_alpha(p) @@ -434,25 +460,30 @@ Converts the specified character to lowercase. #define toTITLE_utf8(p) to_utf8_title(p) #define toLOWER_utf8(p) to_utf8_lower(p) -#define isALNUM_LC_utf8(p) isALNUM_LC_uni(utf8_to_uv(p, 0)) -#define isIDFIRST_LC_utf8(p) isIDFIRST_LC_uni(utf8_to_uv(p, 0)) -#define isALPHA_LC_utf8(p) isALPHA_LC_uni(utf8_to_uv(p, 0)) -#define isSPACE_LC_utf8(p) isSPACE_LC_uni(utf8_to_uv(p, 0)) -#define isDIGIT_LC_utf8(p) isDIGIT_LC_uni(utf8_to_uv(p, 0)) -#define isUPPER_LC_utf8(p) isUPPER_LC_uni(utf8_to_uv(p, 0)) -#define isLOWER_LC_utf8(p) isLOWER_LC_uni(utf8_to_uv(p, 0)) -#define isALNUMC_LC_utf8(p) isALNUMC_LC_uni(utf8_to_uv(p, 0)) -#define isCNTRL_LC_utf8(p) isCNTRL_LC_uni(utf8_to_uv(p, 0)) -#define isGRAPH_LC_utf8(p) isGRAPH_LC_uni(utf8_to_uv(p, 0)) -#define isPRINT_LC_utf8(p) isPRINT_LC_uni(utf8_to_uv(p, 0)) -#define isPUNCT_LC_utf8(p) isPUNCT_LC_uni(utf8_to_uv(p, 0)) -#define toUPPER_LC_utf8(p) toUPPER_LC_uni(utf8_to_uv(p, 0)) -#define toTITLE_LC_utf8(p) toTITLE_LC_uni(utf8_to_uv(p, 0)) -#define toLOWER_LC_utf8(p) toLOWER_LC_uni(utf8_to_uv(p, 0)) +#define isPSXSPC_utf8(c) (isSPACE_utf8(c) ||(c) == '\f') +#define isBLANK_utf8(c) isBLANK(c) /* could be wrong */ + +#define isALNUM_LC_utf8(p) isALNUM_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) +#define isIDFIRST_LC_utf8(p) isIDFIRST_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) +#define isALPHA_LC_utf8(p) isALPHA_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) +#define isSPACE_LC_utf8(p) isSPACE_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) +#define isDIGIT_LC_utf8(p) isDIGIT_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) +#define isUPPER_LC_utf8(p) isUPPER_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) +#define isLOWER_LC_utf8(p) isLOWER_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) +#define isALNUMC_LC_utf8(p) isALNUMC_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) +#define isCNTRL_LC_utf8(p) isCNTRL_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) +#define isGRAPH_LC_utf8(p) isGRAPH_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) +#define isPRINT_LC_utf8(p) isPRINT_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) +#define isPUNCT_LC_utf8(p) isPUNCT_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) +#define toUPPER_LC_utf8(p) toUPPER_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) +#define toTITLE_LC_utf8(p) toTITLE_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) +#define toLOWER_LC_utf8(p) toLOWER_LC_uni(utf8_to_uv(p, UTF8_MAXLEN, 0, 0)) + +#define isPSXSPC_LC_utf8(c) (isSPACE_LC_utf8(c) ||(c) == '\f') +#define isBLANK_LC_utf8(c) isBLANK(c) /* could be wrong */ #ifdef EBCDIC -EXT int ebcdic_control (int); -# define toCTRL(c) ebcdic_control(c) +# define toCTRL(c) Perl_ebcdic_control(c) #else /* This conversion works both ways, strangely enough. */ # define toCTRL(c) (toUPPER(c) ^ 64) @@ -467,7 +498,7 @@ typedef U16 line_t; #endif -/* +/* XXX LEAKTEST doesn't really work in perl5. There are direct calls to safemalloc() in the source, so LEAKTEST won't pick them up. (The main "offenders" are extensions.) @@ -484,7 +515,7 @@ typedef U16 line_t; Creates a new SV. A non-zero C parameter indicates the number of bytes of preallocated string space the SV should have. An extra byte for a tailing NUL is also reserved. (SvPOK is not set for the SV even if string -space is allocated.) The reference count for the new SV is set to 1. +space is allocated.) The reference count for the new SV is set to 1. C is an integer id between 0 and 1299 (used to identify leaks). =for apidoc Am|void|New|int id|void* ptr|int nitems|type @@ -505,7 +536,7 @@ The XSUB-writer's interface to the C C function. The XSUB-writer's interface to the C C function, with cast. -=for apidoc Am|void|Safefree|void* src|void* dest|int nitems|type +=for apidoc Am|void|Safefree|void* ptr The XSUB-writer's interface to the C C function. =for apidoc Am|void|Move|void* src|void* dest|int nitems|type @@ -524,7 +555,7 @@ The XSUB-writer's interface to the C C function. The C is the destination, C is the number of items, and C is the type. =for apidoc Am|void|StructCopy|type src|type dest|type -This is an architecture-independant macro to copy one structure to another. +This is an architecture-independent macro to copy one structure to another. =cut */ diff --git a/contrib/perl5/hints/README.hints b/contrib/perl5/hints/README.hints index 5f23b29c2cbd..066677195258 100644 --- a/contrib/perl5/hints/README.hints +++ b/contrib/perl5/hints/README.hints @@ -9,7 +9,7 @@ can't or doesn't guess properly. Most of these hint files have been tested with at least some version of perl5, but some are still left over from perl4. -Please send any problems or suggested changes to perlbug@perl.com. +Please send any problems or suggested changes to perlbug@perl.org. =head1 Hint file naming convention. diff --git a/contrib/perl5/hints/aix.sh b/contrib/perl5/hints/aix.sh index d6f3dd78e0f0..25a15e497984 100644 --- a/contrib/perl5/hints/aix.sh +++ b/contrib/perl5/hints/aix.sh @@ -128,6 +128,13 @@ d_setreuid='undef' # Tell perl which symbols to export for dynamic linking. case "$cc" in *gcc*) ccdlflags='-Xlinker' ;; +*) ccversion=`lslpp -L | grep 'C for AIX Compiler$' | awk '{print $2}'` + case "$ccversion" in + 4.4.0.0|4.4.0.1|4.4.0.2) + echo >&4 "*** This C compiler ($ccversion) is outdated." + echo >&4 "*** Please upgrade to at least 4.4.0.3." + ;; + esac esac # the required -bE:$installarchlib/CORE/perl.exp is added by # libperl.U (Configure) later. @@ -149,6 +156,20 @@ case "$osvers" in lddlflags="$lddlflags -bhalt:4 -bM:SRE -bI:\$(PERL_INC)/perl.exp -bE:\$(BASEEXT).exp -b noentry -lc" ;; esac +# AIX 4.2 (using latest patchlevels on 20001130) has a broken bind +# library (getprotobyname and getprotobynumber are outversioned by +# the same calls in libc, at least for xlc version 3... +case "`oslevel`" in + 4.2.1.*) # Test for xlc version too, should we? + case "$ccversion" in # Don't know if needed for gcc + 3.1.4.*) # libswanted "bind ... c ..." => "... c bind ..." + set `echo X "$libswanted "| sed -e 's/ bind\( .*\) \([cC]\) / \1 \2 bind /'` + shift + libswanted="$*" + ;; + esac + ;; + esac # This script UU/usethreads.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use threads. @@ -171,9 +192,9 @@ $define|true|[yY]*) ;; *) cat >&4 < UU/uselargefiles.cbu <<'EOCBU' case "$uselargefiles" in ''|$define|true|[yY]*) - lfcflags="`getconf XBS5_ILP32_OFFBIG_CFLAGS 2>/dev/null`" - lfldflags="`getconf XBS5_ILP32_OFFBIG_LDFLAGS 2>/dev/null`" +# Keep these at the left margin. +ccflags_uselargefiles="`getconf XBS5_ILP32_OFFBIG_CFLAGS 2>/dev/null`" +ldflags_uselargefiles="`getconf XBS5_ILP32_OFFBIG_LDFLAGS 2>/dev/null`" # _Somehow_ in AIX 4.3.1.0 the above getconf call manages to # insert(?) *something* to $ldflags so that later (in Configure) evaluating # $ldflags causes a newline after the '-b64' (the result of the getconf). # (nothing strange shows up in $ldflags even in hexdump; - # so it may be something in the shell, instead?) + # so it may be something (a bug) in the shell, instead?) # Try it out: just uncomment the below line and rerun Configure: -# echo >&4 "AIX 4.3.1.0 $lfldflags mystery" ; exit 1 +# echo >&4 "AIX 4.3.1.0 $ldflags_uselargefiles mystery" ; exit 1 # Just don't ask me how AIX does it, I spent hours wondering. - # Therefore the line re-evaluating lfldflags: it seems to fix + # Therefore the line re-evaluating ldflags_uselargefiles: it seems to fix # the whatever it was that AIX managed to break. --jhi - lfldflags="`echo $lfldflags`" - lflibs="`getconf XBS5_ILP32_OFFBIG_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" - case "$lfcflags$lfldflags$lflibs" in + ldflags_uselargefiles="`echo $ldflags_uselargefiles`" +# Keep this at the left margin. +libswanted_uselargefiles="`getconf XBS5_ILP32_OFFBIG_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" + case "$ccflags_uselargefiles$ldflags_uselargefiles$libs_uselargefiles" in '');; - *) ccflags="$ccflags $lfcflags" - ldflags="$ldflags $lfldflags" - libswanted="$libswanted $lflibs" + *) ccflags="$ccflags $ccflags_uselargefiles" + ldflags="$ldflags $ldflags_uselargefiles" + libswanted="$libswanted $libswanted_uselargefiles" ;; esac - lfcflags='' - lfldflags='' - lflibs='' - ;; + case "$gccversion" in + '') ;; + *) + cat >&4 <&4 "(using ccflags $ccflags)" + echo >&4 "(using ldflags $ldflags)" + ;; + esac + ;; esac EOCBU @@ -279,18 +316,18 @@ int main (void) EOCP set size if eval $compile_ok; then - lfcpuwidth=`./size` - echo "You are running on $lfcpuwidth bit hardware." + qacpuwidth=`./size` + echo "You are running on $qacpuwidth bit hardware." else dflt="32" echo " " echo "(I can't seem to compile the test program. Guessing...)" rp="What is the width of your CPU (in bits)?" . ./myread - lfcpuwidth="$ans" + qacpuwidth="$ans" fi $rm -f size.c size - case "$lfcpuwidth" in + case "$qacpuwidth" in 32*) cat >&4 < UU/uselongdouble.cbu <<'EOCBU' # after it has prompted the user for whether to use long doubles. case "$uselongdouble" in $define|true|[yY]*) - ccflags="$ccflags -qlongdouble" + case "$cc" in + *gcc*) ;; + *) ccflags="$ccflags -qlongdouble" ;; + esac # The explicit cc128, xlc128, xlC128 are not needed, # the -qlongdouble should do the trick. --jhi d_Gconvert='sprintf((b),"%.*llg",(n),(x))' diff --git a/contrib/perl5/hints/bsdos.sh b/contrib/perl5/hints/bsdos.sh index c54a0c1606b0..58755434a385 100644 --- a/contrib/perl5/hints/bsdos.sh +++ b/contrib/perl5/hints/bsdos.sh @@ -3,8 +3,12 @@ # hints file for BSD/OS (adapted from bsd386.sh) # Original by Neil Bowers ; Tue Oct 4 12:01:34 EDT 1994 # Updated by Tony Sanders ; Sat Aug 23 12:47:45 MDT 1997 -# Added 3.1 with ELF dynamic libraries (NOT in 3.1 yet. Estimated for 4.0) -# SYSV IPC tested Ok so I re-enabled. +# Added 3.1 with ELF dynamic libraries (NOT in 3.1 yet. +# Estimated for 4.0) SYSV IPC tested Ok so I re-enabled. +# +# Updated to work in post-4.0 by Todd C. Miller +# +# Updated for threads by "Timur I. Bakeyev" # # To override the compiler on the command line: # ./Configure -Dcc=gcc2 @@ -18,7 +22,7 @@ d_voidsig='define' usemymalloc='n' # setre?[ug]id() have been replaced by the _POSIX_SAVED_IDS versions. -# See http://www.bsdi.com/bsdi-man?setuid(2) +# See http://www.bsdi.com/bsdi-man?setuid(2) d_setregid='undef' d_setreuid='undef' d_setrgid='undef' @@ -85,8 +89,8 @@ case "$osvers" in libswanted="Xpm Xaw Xmu Xt SM ICE Xext X11 $libswanted" libswanted="rpc curses termcap $libswanted" ;; -4.0*) - # ELF dynamic link libraries starting in 4.0 (???) +4.*) + # ELF dynamic link libraries starting in 4.0 useshrplib='true' so='so' dlext='so' @@ -94,13 +98,34 @@ case "$osvers" in case "$cc" in '') cc='cc' # cc is gcc2 in 4.0 cccdlflags="-fPIC" - ccdlflags=" " ;; + ccdlflags="-rdynamic -Wl,-rpath,$privlib/$archname/CORE" + ;; esac case "$ld" in '') ld='ld' lddlflags="-shared -x $lddlflags" ;; esac - ;; + # Due usage of static pointer from crt.o + libswanted="util $libswanted" ;; esac +# This script UU/usethreads.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use threads. +cat > UU/usethreads.cbu <<'EOCBU' +case "$usethreads" in +$define|true|[yY]*) + case "$osvers" in + 3.*|4.*) ccflags="-D_REENTRANT $ccflags" + ;; + *) cat <&4 +I did not know that BSD/OS $osvers supports POSIX threads. + +Feel free to tell perlbug@perl.org otherwise. +EOM + exit 1 + ;; + esac + ;; +esac +EOCBU diff --git a/contrib/perl5/hints/cygwin.sh b/contrib/perl5/hints/cygwin.sh index 42114c249f0a..c57d3f6fdf76 100644 --- a/contrib/perl5/hints/cygwin.sh +++ b/contrib/perl5/hints/cygwin.sh @@ -19,9 +19,13 @@ then plibpth=`cd $plibpth && pwd` fi so='dll' -# - eliminate -lc, implied by gcc +# - eliminate -lc, implied by gcc and a symlink to libcygwin.a libswanted=`echo " $libswanted " | sed -e 's/ c / /g'` -libswanted="$libswanted cygipc cygwin kernel32" +# - eliminate -lm, symlink to libcygwin.a +libswanted=`echo " $libswanted " | sed -e 's/ m / /g'` +libswanted="$libswanted cygipc" +test -z "$optimize" && optimize='-O2' +ccflags="$ccflags -DPERL_USE_SAFE_PUTENV" # - otherwise i686-cygwin archname='cygwin' @@ -34,11 +38,6 @@ ld='ld2' # - perl malloc needs to be unpolluted bincompat5005='undef' -# stubs (ENOSYS, not implemented) -d_chroot='undef' -d_seteuid='undef' -d_setegid='undef' - # Win9x problem with non-blocking read from a closed pipe d_eofnblk='define' diff --git a/contrib/perl5/hints/darwin.sh b/contrib/perl5/hints/darwin.sh index fd61e424b03c..8625798d5364 100644 --- a/contrib/perl5/hints/darwin.sh +++ b/contrib/perl5/hints/darwin.sh @@ -47,7 +47,7 @@ ld='cc'; so='dylib'; dlext='bundle'; dlsrc='dl_dyld.xs'; usedl='define'; -cccdlflags=''; +cccdlflags=' '; # space, not empty, because otherwise we get -fpic lddlflags="${ldflags} -bundle -undefined suppress"; ldlibpthname='DYLD_LIBRARY_PATH'; useshrplib='true'; diff --git a/contrib/perl5/hints/dec_osf.sh b/contrib/perl5/hints/dec_osf.sh index db7b869cf2be..ce3a40c77dbc 100644 --- a/contrib/perl5/hints/dec_osf.sh +++ b/contrib/perl5/hints/dec_osf.sh @@ -65,32 +65,42 @@ cc=${cc:-cc} # reset _DEC_cc_style= case "`$cc -v 2>&1 | grep cc`" in -*gcc*) _gcc_version=`$cc -v 2>&1 | grep "gcc version" | sed 's%^gcc version \([0-9]*\)\.\([0-9]*\) .*%\1 \2%'` +*gcc*) _gcc_version=`$cc --version 2>&1 | tr . ' '` set $_gcc_version - if test "$1" -lt 2 -o \( "$1" -eq 2 -a "$2" -lt 95 \); then + if test "$1" -lt 2 -o \( "$1" -eq 2 -a \( "$2" -lt 95 -o \( "$2" -eq 95 -a "$3" -lt 2 \) \) \); then cat >&4 <&4 <&1`" in */gemc_cc*) # we have the new DEC GEM CC diff --git a/contrib/perl5/hints/dos_djgpp.sh b/contrib/perl5/hints/dos_djgpp.sh index d50bca4b25e0..ebbd786b45e6 100644 --- a/contrib/perl5/hints/dos_djgpp.sh +++ b/contrib/perl5/hints/dos_djgpp.sh @@ -41,10 +41,13 @@ startperl='#!perl' case "X$optimize" in X) optimize="-O2 -malign-loops=2 -malign-jumps=2 -malign-functions=2" + ldflags='-s' + ;; + X*) + ldflags=' ' ;; esac ccflags="$ccflags -DPERL_EXTERNAL_GLOB" -ldflags='-s' usemymalloc='n' timetype='time_t' diff --git a/contrib/perl5/hints/freebsd.sh b/contrib/perl5/hints/freebsd.sh index fd60ba3cb919..8eb6ac47b040 100644 --- a/contrib/perl5/hints/freebsd.sh +++ b/contrib/perl5/hints/freebsd.sh @@ -86,8 +86,6 @@ case "$osvers" in d_setegid='undef' d_seteuid='undef' ;; -# -# Guesses at what will be needed after 2.2 *) usevfork='true' usemymalloc='n' libswanted=`echo $libswanted | sed 's/ malloc / /'` @@ -179,7 +177,7 @@ $define|true|[yY]*) 0*|1*|2.0*|2.1*) cat <&4 I did not know that FreeBSD $osvers supports POSIX threads. -Feel free to tell perlbug@perl.com otherwise. +Feel free to tell perlbug@perl.org otherwise. EOM exit 1 ;; @@ -189,7 +187,8 @@ EOM POSIX threads are not supported well by FreeBSD $osvers. Please consider upgrading to at least FreeBSD 2.2.8, -or preferably to 3.something. +or preferably to the most recent -RELEASE or -STABLE +version (see http://www.freebsd.org/releases/). (While 2.2.7 does have pthreads, it has some problems with the combination of threads and pipes and therefore diff --git a/contrib/perl5/hints/hpux.sh b/contrib/perl5/hints/hpux.sh index ce15f552b44b..464f301427d0 100644 --- a/contrib/perl5/hints/hpux.sh +++ b/contrib/perl5/hints/hpux.sh @@ -23,6 +23,11 @@ # HP-UX 10 pthreads hints: Matthew T Harden # From: Dominic Dunlop # Abort and offer advice if bundled (non-ANSI) C compiler selected +# From: H.Merijn Brand +# ccversion detection +# perl/64/HP-UX wants libdb-3.0 to be shared ELF 64 +# generic pthread support detection for PTH package + # This version: March 8, 2000 # Current maintainer: Jeff Okamoto @@ -105,9 +110,13 @@ EOM ;; esac +cc=${cc:-cc} + case `$cc -v 2>&1`"" in *gcc*) ccisgcc="$define" ;; -*) ccisgcc='' ;; +*) ccisgcc='' + ccversion=`which cc | xargs what | awk '/Compiler/{print $2}'` + ;; esac # Determine the architecture type of this system. @@ -154,7 +163,6 @@ $define|true|[yY]*) 64-bit compilation is not supported on HP-UX $xxOsRevMajor. You need at least HP-UX 11.0. Cannot continue, aborting. - EOM exit 1 fi @@ -167,7 +175,6 @@ EOM *** You do not seem to have the 64-bit libraries in /lib/pa20_64. *** Most importantly, I cannot find the $libc. *** Cannot continue, aborting. - EOM exit 1 fi @@ -175,6 +182,7 @@ EOM ccflags="$ccflags +DD64" ldflags="$ldflags +DD64" test -d /lib/pa20_64 && loclibpth="$loclibpth /lib/pa20_64" + libswanted="$libswanted pthread" libscheck='case "`/usr/bin/file $xxx`" in *LP64*|*PA-RISC2.0*) ;; *) xxx=/no/64-bit$xxx ;; @@ -321,6 +329,7 @@ case "$usethreads" in $define|true|[yY]*) if [ "$xxOsRevMajor" -lt 10 ]; then cat <&4 + HP-UX $xxOsRevMajor cannot support POSIX threads. Consider upgrading to at least HP-UX 11. Cannot continue, aborting. @@ -329,33 +338,56 @@ EOM fi case "$xxOsRevMajor" in 10) - # Under 10.X, a threaded perl can be built, but it needs - # libcma and OLD_PTHREADS_API. Also needs to - # be #included before any other includes (in perl.h) - if [ ! -f /usr/include/pthread.h -o ! -f /usr/lib/libcma.sl ]; then + # Under 10.X, a threaded perl can be built + if [ -f /usr/include/pthread.h ]; then + if [ -f /usr/lib/libcma.sl ]; then + # DCE (from Core OS CD) is installed + + # It needs # libcma and OLD_PTHREADS_API. Also + # needs to be #included before any other includes + # (in perl.h) + + # HP-UX 10.X uses the old pthreads API + d_oldpthreads="$define" + + # include libcma before all the others + libswanted="cma $libswanted" + + # tell perl.h to include before other include files + ccflags="$ccflags -DPTHREAD_H_FIRST" + + # CMA redefines select to cma_select, and cma_select expects int * + # instead of fd_set * (just like 9.X) + selecttype='int *' + + elif [ -f /usr/lib/libpthread.sl ]; then + # PTH package is installed + libswanted="pthread $libswanted" + else + libswanted="no_threads_available" + fi + else + libswanted="no_threads_available" + fi + + if [ $libswanted = "no_threads_available" ]; then cat <&4 + In HP-UX 10.X for POSIX threads you need both of the files -/usr/include/pthread.h and /usr/lib/libcma.sl. -Either you must install the CMA package or you must upgrade to HP-UX 11. +/usr/include/pthread.h and either /usr/lib/libcma.sl or /usr/lib/libpthread.sl. +Either you must upgrade to HP-UX 11 or install a posix thread library: + + DCE-CoreTools from HP-UX 10.20 Hardware Extensions 3.0 CD (B3920-13941) + +or + + PTH package from http://hpux.tn.tudelft.nl/hppd/hpux/alpha.html + Cannot continue, aborting. EOM exit 1 - fi + fi - # HP-UX 10.X uses the old pthreads API - case "$d_oldpthreads" in - '') d_oldpthreads="$define" ;; - esac - - # include libcma before all the others - libswanted="cma $libswanted" - - # tell perl.h to include before other include files - ccflags="$ccflags -DPTHREAD_H_FIRST" - - # CMA redefines select to cma_select, and cma_select expects int * - # instead of fd_set * (just like 9.X) - selecttype='int *' ;; 11 | 12) # 12 may want upping the _POSIX_C_SOURCE datestamp... ccflags=" -D_POSIX_C_SOURCE=199506L $ccflags" @@ -387,8 +419,10 @@ cat > UU/uselargefiles.cbu <<'EOCBU' case "$uselargefiles" in ''|$define|true|[yY]*) # there are largefile flags available via getconf(1) - # but we cheat for now. - ccflags="$ccflags -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64" + # but we cheat for now. (Keep that in the left margin.) +ccflags_uselargefiles="-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64" + + ccflags="$ccflags $ccflags_uselargefiles" if test -z "$ccisgcc" -a -z "$gccversion"; then # The strict ANSI mode (-Aa) doesn't like large files. diff --git a/contrib/perl5/hints/irix_6.sh b/contrib/perl5/hints/irix_6.sh index 9d9852d04919..e6117cf1af91 100644 --- a/contrib/perl5/hints/irix_6.sh +++ b/contrib/perl5/hints/irix_6.sh @@ -32,6 +32,14 @@ # Don't bother with -n32 unless you have the 7.1 or later compilers. # But there's no quick and light-weight way to check in 6.2. +# NOTE: some IRIX cc versions, e.g. 7.3.1.1m (try cc -version) have +# been known to have issues (coredumps) when compiling perl.c. +# If you've used -OPT:fast_io=ON and this happens, try removing it. +# If that fails, or you didn't use that, then try adjusting other +# optimization options (-LNO, -INLINE, -O3 to -O2, etcetera). +# The compiler bug has been reported to SGI. +# -- Allen Smith + # Let's assume we want to use 'cc -n32' by default, unless the # necessary libm is missing (which has happened at least twice) case "$cc" in @@ -40,7 +48,13 @@ case "$cc" in *) test -f /usr/lib32/libm.so && cc='cc -n32' ;; esac esac -test -z "$cc" && cc=cc + +cc=${cc:-cc} + +case "$cc" in +*gcc*) ;; +*) ccversion=`cc -version` ;; +esac case "$use64bitint" in $define|true|[yY]*) @@ -77,9 +91,19 @@ esac case "$cc" in *"cc -n32"*) - libscheck='case "`/usr/bin/file $xxx`" in -*N32*) ;; -*) xxx=/no/n32$xxx ;; + # If a library is requested to link against, make sure the + # objects in the library are of the same ABI we are compiling + # against. Albert Chin-A-Young + libscheck='case "$xxx" in +*.a) /bin/ar p $xxx `/bin/ar t $xxx | /usr/bsd/head -1` >$$.o; + case "`/usr/bin/file $$.o`" in + *N32*) rm -f $$.o ;; + *) rm -f $$.o; xxx=/no/n32$xxx ;; + esac ;; +*) case "`/usr/bin/file $xxx`" in + *N32*) ;; + *) xxx=/no/n32$xxx ;; + esac ;; esac' # NOTE: -L/usr/lib32 -L/lib32 are automatically selected by the linker @@ -93,7 +117,7 @@ esac' libc='/usr/lib32/libc.so' plibpth='/usr/lib32 /lib32 /usr/ccs/lib' ;; -*"cc -64") +*"cc -64"*) loclibpth="$loclibpth /usr/lib64" libscheck='case "`/usr/bin/file $xxx`" in @@ -138,7 +162,7 @@ esac # Settings common to both native compiler modes. case "$cc" in -*"cc -n32"|*"cc -64") +*"cc -n32"*|*"cc -64"*) ld=$cc # perl's malloc can return improperly aligned buffer @@ -216,8 +240,10 @@ esac # Don't groan about unused libraries. ldflags="$ldflags -Wl,-woff,84" +# workaround for an optimizer bug case "`$cc -version 2>&1`" in -*7.2.*) op_cflags='optimize=-O1' ;; # workaround for an optimizer bug +*7.2.*) op_cflags='optimize=-O1'; opmini_cflags='optimize=-O1' ;; +*7.3.1.*) op_cflags='optimize=-O2'; opmini_cflags='optimize=-O2' ;; esac # We don't want these libraries. diff --git a/contrib/perl5/hints/linux.sh b/contrib/perl5/hints/linux.sh index 4fb2f89e7c2a..a6b2bd985ab0 100644 --- a/contrib/perl5/hints/linux.sh +++ b/contrib/perl5/hints/linux.sh @@ -189,7 +189,7 @@ fi rm -f try.c a.out -if /bin/bash -c exit; then +if /bin/sh -c exit; then echo '' echo 'You appear to have a working bash. Good.' else @@ -282,7 +282,10 @@ cat > UU/uselargefiles.cbu <<'EOCBU' # after it has prompted the user for whether to use large files. case "$uselargefiles" in ''|$define|true|[yY]*) - ccflags="$ccflags -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64" +# Keep this in the left margin. +ccflags_uselargefiles="-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64" + + ccflags="$ccflags $ccflags_uselargefiles" ;; esac EOCBU diff --git a/contrib/perl5/hints/machten.sh b/contrib/perl5/hints/machten.sh index b4409c1bf0be..3a311a1746a3 100644 --- a/contrib/perl5/hints/machten.sh +++ b/contrib/perl5/hints/machten.sh @@ -15,6 +15,9 @@ # Martijn Koster # Richard Yeh # +# Deny system's false claims to support mmap() and munmap(); note +# also that Sys V IPC (re)disabled by jhi due to continuing inadequacy +# -- Dominic Dunlop 001111 # Remove dynamic loading libraries from search; enable SysV IPC with # MachTen 4.1.4 and above; define SYSTEM_ALIGN_BYTES for old MT versions # -- Dominic Dunlop 000224 @@ -46,10 +49,7 @@ # # MachTen 4.1.1's support for shadow password file access is incomplete: # disable its use completely. -d_endspent=${d_endspent:-undef} -d_getspent=${d_getspent:-undef} d_getspnam=${d_getspnam:-undef} -d_setspent=${d_setspent:-undef} # MachTen 4.1.1 does support dynamic loading, but perl doesn't # know how to use it yet. @@ -200,6 +200,11 @@ if test "$d_shm" = ""; then esac fi +# MachTen has stubs for mmap and munmap(), but they just result in the +# caller being killed on the grounds of "Bad system call" +d_mmap=${d_mmap:-undef} +d_munmap=${d_munmap:-undef} + # Get rid of some extra libs which it takes Configure a tediously # long time never to find on MachTen, or which break perl set `echo X "$libswanted "|sed -e 's/ net / /' -e 's/ socket / /' \ @@ -231,6 +236,8 @@ During Configure, you may see the message as well as similar messages concerning \$d_sem and \$d_shm. Select the default answers: MachTen 4.1 appears to provide System V IPC support, but it is incomplete and buggy: perl should be built without it. +Similar considerations apply to memory mapping of files, controlled +by \$d_mmap and \$d_munmap. Similarly, when you see @@ -241,10 +248,9 @@ Similarly, when you see select the default answer: vfork() works, and avoids expensive data copying. -You may also see "WHOA THERE!!!" messages concerning \$d_endspent, -\$d_getspent, \$d_getspnam and \$d_setspent. In all cases, select the -default answer: MachTen's support for shadow password file access is -incomplete, and should not be used. +You may also see "WHOA THERE!!!" messages concerning \$d_getspnam. +Select the default answer: MachTen's support for shadow password +file access is incomplete, and should not be used. At the end of Configure, you will see a harmless message diff --git a/contrib/perl5/hints/mint.sh b/contrib/perl5/hints/mint.sh index ab55e612e100..b9a7886f9ad5 100644 --- a/contrib/perl5/hints/mint.sh +++ b/contrib/perl5/hints/mint.sh @@ -53,7 +53,6 @@ d_fsetpos='fpos_t' gidtype='gid_t' groupstype='gid_t' lseektype='long' -models='none' modetype='mode_t' sizetype='size_t' timetype='time_t' diff --git a/contrib/perl5/hints/mpeix.sh b/contrib/perl5/hints/mpeix.sh index 556d22148c62..d2ca5f09af47 100644 --- a/contrib/perl5/hints/mpeix.sh +++ b/contrib/perl5/hints/mpeix.sh @@ -10,9 +10,10 @@ # Created for 5.003 by Mark Klein, mklein@dis.com. # Substantially revised for 5.004_01 by Mark Bixby, markb@cccd.edu. # Revised again for 5.004_69 by Mark Bixby, markb@cccd.edu. +# Revised for 5.6.0 by Mark Bixby, mbixby@power.net. # osname='mpeix' -osvers='5.5' # Isn't there a way to determine this dynamically? +osvers=`uname -r | sed -e 's/.[A-Z]\.\([0-9]\)\([0-9]\)\.[0-9][0-9]/\1.\2/'` # # Force Configure to use our wrapper mpeix/nm script # @@ -53,16 +54,34 @@ toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"' # Linking. # lddlflags='-b' -# What if you want additional libs (e.g. gdbm)? -# This should remove the unwanted libraries from $libswanted and -# add on whatever ones are needed instead. -libs="$libs -lbind -lsyslog -lcurses -lsvipc -lsocket -lm -lc" +# Delete bsd and BSD from the library list. Remove other randomly ordered +# libraries and then re-add them in their proper order (the MPE linker is +# order-sensitive). Add additional MPE-specific libraries. +for mpe_remove in bind bsd BSD c curses m socket str svipc syslog; do + set `echo " $libswanted " | sed -e 's/ / /g' -e "s/ $mpe_remove //"` + libswanted="$*" +done +libswanted="$libswanted bind syslog curses svipc socket str m c" loclibpth="$loclibpth /usr/local/lib /usr/contrib/lib /BIND/PUB/lib /SYSLOG/PUB" # # External functions and data items. # -# Does Configure *really* get *all* of these wrong? +# Q: Does Configure *really* get *all* of these wrong? # +# A: Yes. There are two MPE problems here. The 'undef' functions exist on MPE, +# but are merely dummy routines that return ENOTIMPL or ESYSERR. Since they're +# useless, let's just tell Perl to avoid them. Also, a few data items are +# 'undef' because while they may exist in structures, they are uninitialized. +# +# The 'define' cases are a bit weirder. MPE has a libc.a, libc.sl, and two +# special kernel shared libraries, /SYS/PUB/XL and /SYS/PUB/NL. Much of what +# is in libc.a is duplicated within XL and NL, so when we created libc.sl, we +# omitted the duplicated functions. Since Configure end ups scanning libc.sl, +# we need to 'define' the functions that had been removed. +# +# We don't want to scan XL or NL because we would find way too many POSIX or +# Unix named functions that are really vanilla MPE functions that do something +# completely different than on POSIX or Unix. d_crypt='define' d_difftime='define' d_dlerror='undef' @@ -100,7 +119,7 @@ d_wctomb='define' # # Include files. # -i_termios='undef' +i_termios='undef' # we have termios, but not the full set (just tcget/setattr) i_time='define' i_systime='undef' i_systimek='undef' @@ -109,3 +128,8 @@ timeincl='/usr/include/time.h' # Data types. # timetype='time_t' +# +# Functionality. +# +bincompat5005="$undef" +uselargefiles="$undef" diff --git a/contrib/perl5/hints/openbsd.sh b/contrib/perl5/hints/openbsd.sh index a7d8bf2950af..25781577ff26 100644 --- a/contrib/perl5/hints/openbsd.sh +++ b/contrib/perl5/hints/openbsd.sh @@ -26,8 +26,9 @@ d_setruid=$undef # # Not all platforms support dynamic loading... # -case `arch` in -OpenBSD.alpha|OpenBSD.mips|OpenBSD.powerpc|OpenBSD.vax) +ARCH=`arch|sed 's/^OpenBSD.//'` +case "${ARCH}-${osvers}" in +alpha-*|mips-*|vax-*|powerpc-2.[0-7]|m88k-*) usedl=$undef ;; *) @@ -37,7 +38,15 @@ OpenBSD.alpha|OpenBSD.mips|OpenBSD.powerpc|OpenBSD.vax) # we use -fPIC here because -fpic is *NOT* enough for some of the # extensions like Tk on some OpenBSD platforms (ie: sparc) cccdlflags="-DPIC -fPIC $cccdlflags" - lddlflags="-Bshareable $lddlflags" + case "$osvers" in + [01].*|2.[0-7]|2.[0-7].*) + lddlflags="-Bshareable $lddlflags" + ;; + *) # from 2.8 onwards + ld=${cc:-cc} + lddlflags="-shared -fPIC $lddlflags" + ;; + esac ;; esac @@ -60,7 +69,14 @@ d_suidsafe=$define # cc is gcc so we can do better than -O # Allow a command-line override, such as -Doptimize=-g -test "$optimize" || optimize='-O2' +case "$ARCH" in +m88k) + optimize='-O0' + ;; +*) + test "$optimize" || optimize='-O2' + ;; +esac # This script UU/usethreads.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use threads. @@ -87,6 +103,9 @@ case "$openbsd_distribution" in sysman='/usr/share/man/man1' libpth='/usr/lib' glibpth='/usr/lib' + # Local things, however, do go in /usr/local + siteprefix='/usr/local' + siteprefixexp='/usr/local' # Ports installs non-std libs in /usr/local/lib so look there too locincpth='/usr/local/include' loclibpth='/usr/local/lib' diff --git a/contrib/perl5/hints/os2.sh b/contrib/perl5/hints/os2.sh index 1d9df3683f8a..5ffa589d310c 100644 --- a/contrib/perl5/hints/os2.sh +++ b/contrib/perl5/hints/os2.sh @@ -93,7 +93,7 @@ if test "$libemx" = "X"; then echo "Cannot find C library!" >&2; fi libpth="`echo \"$LIBRARY_PATH\" | tr ';\\\' ' /'`" libpth="$libpth $libemx/mt $libemx" -set `emxrev -f emxlibcm` +set `cmd /c emxrev -f emxlibcm` emxcrtrev=$5 # indented to not put it into config.sh _defemxcrtrev=-D_EMX_CRT_REV_=$emxcrtrev @@ -249,6 +249,8 @@ nm_opt='-p' ####### We define these functions ourselves +d_strtoll='define' +d_strtoull='define' d_getprior='define' d_setprior='define' @@ -281,8 +283,14 @@ case "$0$running_c_cmd" in # Not patched! if test -f ./Configure.cmd ; then echo "!!!" >&2 - echo "!!! ./Configure not patched, but ./Configure.cmd exits" >&2 - echo "!!! Do not know what to do!" >&2 + echo "!!! I see that what is running is ./Configure." >&2 + echo "!!! ./Configure is not patched, but ./Configure.cmd exists." >&2 + echo "!!!" >&2 + echo "!!! You are supposed to run Configure.cmd, not Configure" >&2 + echo "!!! after an automagic patching." >&2 + echo "!!!" >&2 + echo "!!! If you insist on running Configure, please" >&2 + echo "!!! patch it manually from ./os2/diff.configure." >&2 echo "!!!" >&2 exit 2 fi @@ -306,10 +314,6 @@ case "$0$running_c_cmd" in *) echo "!!! Apparently we are running a renamed Configure: '$0'." >&2 esac -# Copy pod: - -cp -uf ./README.os2 ./pod/perlos2.pod - # This script UU/usethreads.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use threads. cat > UU/usethreads.cbu <<'EOCBU' diff --git a/contrib/perl5/hints/os390.sh b/contrib/perl5/hints/os390.sh index d6f68212422a..4eff5a82174c 100644 --- a/contrib/perl5/hints/os390.sh +++ b/contrib/perl5/hints/os390.sh @@ -3,7 +3,8 @@ # OS/390 hints by David J. Fiander # # OS/390 OpenEdition Release 3 Mon Sep 22 1997 thanks to: -# +# +# John Goodyear # John Pfuntner # Len Johnson # Bud Huff @@ -15,53 +16,148 @@ # # To get ANSI C, we need to use c89, and ld doesn't exist -cc='c89' -ld='c89' -# To link via definition side decks we need the dll option -cccdlflags='-W 0,dll,"langlvl(extended)"' -# c89 hides most of the useful header stuff, _ALL_SOURCE turns it on again, +# You can override this with Configure -Dcc=gcc -Dld=ld. +case "$cc" in +'') cc='c89' ;; +esac +case "$ld" in +'') ld='c89' ;; +esac + +# -DMAXSIG=38 maximum signal number +# -DOEMVS is used in place of #ifdef __MVS__ in certain places. +# -D_OE_SOCKETS alters system headers. +# -D_XOPEN_SOURCE_EXTENDEDA alters system headers. +# c89 hides most of the useful header stuff, _ALL_SOURCE turns it on again. # YYDYNAMIC ensures that the OS/390 yacc generated parser is reentrant. -# -DEBCDIC should come from Configure. -ccflags='-DMAXSIG=38 -DOEMVS -D_OE_SOCKETS -D_XOPEN_SOURCE_EXTENDED -D_ALL_SOURCE -DYYDYNAMIC' -# Turning on optimization breaks perl -optimize='none' +# -DEBCDIC should come from Configure and need not be mentioned here. +# Prepend your favorites with Configure -Dccflags=your_favorites +case "$ccflags" in +'') ccflags='-DMAXSIG=38 -DOEMVS -D_OE_SOCKETS -D_XOPEN_SOURCE_EXTENDED -D_ALL_SOURCE -DYYDYNAMIC' ;; +*) ccflags="$ccflags -DMAXSIG=38 -DOEMVS -D_OE_SOCKETS -D_XOPEN_SOURCE_EXTENDED -D_ALL_SOURCE -DYYDYNAMIC" ;; +esac -alignbytes=8 +# Turning on optimization breaks perl. +# You can override this with Configure -Doptimize='-O' or somesuch. +case "$optimize" in +'') optimize='none' ;; +esac -usemymalloc='n' +# To link via definition side decks we need the dll option +# You can override this with Configure -Ucccdlflags or somesuch. +case "$cccdlflags" in +'') cccdlflags='-W 0,dll' ;; +esac -so='a' +case "$so" in +'') so='a' ;; +esac + +case "$alignbytes" in +'') alignbytes=8 ;; +esac + +case "$usemymalloc" in +'') usemymalloc='n' ;; +esac # On OS/390, libc.a doesn't really hold anything at all, # so running nm on it is pretty useless. -usenm='n' +# You can override this with Configure -Dusenm. +case "$usenm" in +'') usenm='false' ;; +esac -# Dynamic loading doesn't work on OS/390 quite yet -usedl='n' -dlext='none' +# Setting ldflags='-Wl,EDIT=NO' will get rid of the symbol +# information at the end of the executable (=> smaller binaries). +# Override this option with -Dldflags='whatever else you wanted'. +case "$ldflags" in +'') ldflags='-Wl,EDIT=NO' ;; +esac -# Configure can't figure this out for some reason -d_shmatprototype='define' +# In order to build with dynamic be sure to specify: +# Configure -Dusedl +# Do not forget to add $archlibexp/CORE to your LIBPATH. +# You might want to override some of this with things like: +# Configure -Dusedl -Ddlext=so -Ddlsrc=dl_dllload.xs. +case "$usedl" in +'') + usedl='n' + case "$dlext" in + '') dlext='none' ;; + esac + ;; +define) + case "$useshrplib" in + '') useshrplib='true' ;; + esac + case "$dlsrc" in + '') dlsrc='dl_dllload.xs' ;; + esac + # For performance use 'so' at or beyond v2.8, 'dll' for 2.7 and prior versions + case "`uname -v`x`uname -r`" in + 02x0[89].*|02x1[0-9].*|[0-9][3-9]x*) + so='so' + case "$dlext" in + '') dlext='so' ;; + esac + ;; + *) + so='dll' + case "$dlext" in + '') dlext='dll' ;; + esac + ;; + esac + libperl="libperl.$so" + ccflags="$ccflags -D_SHR_ENVIRON -DPERL_EXTERNAL_GLOB -Wc,dll" + cccdlflags='-c -Wc,dll,EXPORTALL' + # The following will need to be modified for the installed libperl.x. + # The modification to Config.pm is done by the installperl script after the build and test. + ccdlflags="-W l,dll `pwd`/libperl.x" + lddlflags="-W l,dll `pwd`/libperl.x" + ;; +esac +# even on static builds using LIBPATH should be OK. +case "$ldlibpthname" in +'') ldlibpthname=LIBPATH ;; +esac -usenm='false' -i_time='define' -i_systime='define' +# Header files to include. +# You can override these with Configure -Ui_time -Ui_systime. +case "$i_time" in +'') i_time='define' ;; +esac +case "$i_systime" in +'') i_systime='define' ;; +esac # (from aix.sh) # uname -m output is too specific and not appropriate here # osname should come from Configure -# +# You can override this with Configure -Darchname='s390' but please don't. case "$archname" in '') archname="$osname" ;; esac -archobjs=ebcdic.o - -# We have our own cppstdin. -echo 'cat >.$$.c; '"$cc"' -E -Wc,NOLOC ${1+"$@"} .$$.c; rm .$$.c' > cppstdin +# We have our own cppstdin script. This is not a variable since +# Configure sees the presence of the script file. +# We put system header -D definitions in so that Configure +# can find the shmat() prototype in and various +# other things. Unfortunately, cppflags occurs too late to be of +# value external to the script. This may need to be revisited +# under a compiler other than c89. +case "$usedl" in +define) +echo 'cat >.$$.c; '"$cc"' -D_OE_SOCKETS -D_XOPEN_SOURCE_EXTENDED -D_ALL_SOURCE -D_SHR_ENVIRON -E -Wc,NOLOC ${1+"$@"} .$$.c; rm .$$.c' > cppstdin + ;; +*) +echo 'cat >.$$.c; '"$cc"' -D_OE_SOCKETS -D_XOPEN_SOURCE_EXTENDED -D_ALL_SOURCE -E -Wc,NOLOC ${1+"$@"} .$$.c; rm .$$.c' > cppstdin + ;; +esac # -# Note that Makefile.SH employs a bare yacc to generate +# Note that Makefile.SH employs a bare yacc command to generate # perly.[hc] and a2p.[hc], hence you may wish to: # # alias yacc='myyacc' diff --git a/contrib/perl5/hints/posix-bc.sh b/contrib/perl5/hints/posix-bc.sh index ec21bc327e44..62752339920c 100644 --- a/contrib/perl5/hints/posix-bc.sh +++ b/contrib/perl5/hints/posix-bc.sh @@ -6,37 +6,89 @@ # thanks to the authors of the os390.sh # -# To get ANSI C, we need to use c89, and ld doesn't exist -cc='c89' -ld='c89' +# To get ANSI C, we need to use c89, and ld does not exist +# You can override this with Configure -Dcc=gcc -Dld=ld. +case "$cc" in +'') cc='c89' ;; +esac +case "$ld" in +'') ld='c89' ;; +esac # C-Flags: -ccflags='-DPOSIX_BC -DUSE_PURE_BISON -D_XOPEN_SOURCE_EXTENDED' +# -DPOSIX_BC +# -DUSE_PURE_BISON +# -D_XOPEN_SOURCE_EXTENDED alters system headers. +# 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_EXTENDED' ;; +*) ccflags='$ccflags -Kenum_long,llm_case_lower,llm_keep,no_integer_overflow -DPOSIX_BC -DUSE_PURE_BISON -D_XOPEN_SOURCE_EXTENDED' ;; +esac + +# ccdlflags have yet to be determined. +#case "$ccdlflags" in +#'') ccdlflags='-c' ;; +#esac + +# cccdlflags have yet to be determined. +#case "$cccdlflags" in +#'') cccdlflags='' ;; +#esac + +# ldflags have yet to be determined. +#case "$ldflags" in +#'') ldflags='' ;; +#esac + +# lddlflags have yet to be determined. +#case "$lddlflags" in +#'') lddlflags='' ;; +#esac # Flags on a RISC-Host (SUNRISE): if [ -n "`bs2cmd SHOW-SYSTEM-INFO | egrep 'HSI-ATT.*TYPE.*SR'`" ]; then echo echo "Congratulations, you are running a machine with Sunrise CPUs." echo "Let's hope you have the matching RISC compiler as well." - ccflags='-K risc_4000 -DPOSIX_BC -DUSE_PURE_BISON -D_XOPEN_SOURCE_EXTENDED' + ccflags="-K risc_4000 $ccflags" ldflags='-K risc_4000' fi # Turning on optimization breaks perl (CORE-DUMP): -optimize='none' +# You can override this with Configure -Doptimize='-O' or somesuch. +case "$optimize" in +'') optimize='none' ;; +esac # we don''t use dynamic memorys (yet): -so='none' -usedl='no' -dlext='none' +case "$so" in +'') so='none' ;; +esac -# On BS2000/Posix, libc.a doesn't really hold anything at all, +case "$usemymalloc" in +'') usemymalloc='n' ;; +esac + +# On BS2000/Posix, libc.a does not really hold anything at all, # so running nm on it is pretty useless. -usenm='no' +# You can override this with Configure -Dusenm. +case "$usenm" in +'') usenm='false' ;; +esac -# other Options: - -usemymalloc='no' - -archobjs=ebcdic.o +# Dynamic loading doesn't work on OS/390 quite yet. +# You can override this with +# Configure -Dusedl -Ddlext=.so -Ddlsrc=dl_dllload.xs. +case "$usedl" in +'') usedl='n' ;; +esac +case "$dlext" in +'') dlext='none' ;; +esac +#case "$dlsrc" in +#'') dlsrc='none' ;; +#esac +#case "$ldlibpthname" in +#'') ldlibpthname=LIBPATH ;; +#esac diff --git a/contrib/perl5/hints/powerux.sh b/contrib/perl5/hints/powerux.sh index 4070c01767e4..dc1b3d07f063 100644 --- a/contrib/perl5/hints/powerux.sh +++ b/contrib/perl5/hints/powerux.sh @@ -63,7 +63,7 @@ lddlflags='-Zlink=so' # i_ndbm='undef' -# I have no clude what perl thinks it wants for, but if +# I have no clue what perl thinks it wants for, but if # you include it in a program in PowerMAX without first including # the code don't compile... # diff --git a/contrib/perl5/hints/solaris_2.sh b/contrib/perl5/hints/solaris_2.sh index 8aee6d40dc00..0bf5bab3afdc 100644 --- a/contrib/perl5/hints/solaris_2.sh +++ b/contrib/perl5/hints/solaris_2.sh @@ -1,35 +1,48 @@ # hints/solaris_2.sh -# Last modified: Tue Apr 13 13:12:49 EDT 1999 +# Last modified: Tue Jan 2 10:16:35 2001 +# Lupe Christoph +# Based on version by: # Andy Dougherty -# Based on input from lots of folks, especially +# Which was based on input from lots of folks, especially # Dean Roehrich +# Additional input from Alan Burlison, Jarkko Hietaniemi, +# and Richard Soderberg. +# +# See README.solaris for additional information. +# +# For consistency with gcc, we do not adopt Sun Marketing's +# removal of the '2.' prefix from the Solaris version number. +# (Configure tries to detect an old fixincludes and needs +# this information.) # If perl fails tests that involve dynamic loading of extensions, and # you are using gcc, be sure that you are NOT using GNU as and ld. One # way to do that is to invoke Configure with -# +# # sh Configure -Dcc='gcc -B/usr/ccs/bin/' # # (Note that the trailing slash is *required*.) # gcc will occasionally emit warnings about "unused prefix", but # these ought to be harmless. See below for more details. - + # See man vfork. usevfork=false d_suidsafe=define # Avoid all libraries in /usr/ucblib. -set `echo $glibpth | sed -e 's@/usr/ucblib@@'` +# /lib is just a symlink to /usr/lib +set `echo $glibpth | sed -e 's@/usr/ucblib@@' -e 's@ /lib @ @'` glibpth="$*" -# Remove bad libraries. -lucb contains incompatible routines. -# -lld doesn't do anything useful. +# Remove unwanted libraries. -lucb contains incompatible routines. +# -lld and -lsec don't do anything useful. -lcrypt does not +# really provide anything we need over -lc, so we drop it, too. # -lmalloc can cause a problem with GNU CC & Solaris. Specifically, # libmalloc.a may allocate memory that is only 4 byte aligned, but # GNU CC on the Sparc assumes that doubles are 8 byte aligned. # Thanks to Hallvard B. Furuseth -set `echo " $libswanted " | sed -e 's@ ld @ @' -e 's@ malloc @ @' -e 's@ ucb @ @'` +set `echo " $libswanted " | sed -e 's@ ld @ @' -e 's@ malloc @ @' -e 's@ ucb @ @' -e 's@ sec @ @' -e 's@ crypt @ @'` libswanted="$*" # Look for architecture name. We want to suggest a useful default. @@ -45,42 +58,35 @@ case "$archname" in ;; esac -test -z "`${cc:-cc} -V 2>&1|grep -i workshop`" || ccisworkshop="$define" -test -z "`${cc:-cc} -v 2>&1|grep -i gcc`" || ccisgcc="$define" - -cat >UU/workshoplibpth.cbu<<'EOCBU' +cat > UU/workshoplibpth.cbu << 'EOCBU' +# This script UU/workshoplibpth.cbu will get 'called-back' +# by other CBUs this script creates. case "$workshoplibpth_done" in -'') case "$use64bitall" in - "$define"|true|[yY]*) - loclibpth="$loclibpth /usr/lib/sparcv9" - if test -n "$workshoplibs"; then - loclibpth=`echo $loclibpth | sed -e "s% $workshoplibs%%" ` - for lib in $workshoplibs; do - # Logically, it should be sparcv9. - # But the reality fights back, it's v9. - loclibpth="$loclibpth $lib/sparcv9 $lib/v9" - done - fi + '') if test `uname -p` = "sparc"; then + case "$use64bitall" in + "$define"|true|[yY]*) + # add SPARC-specific 64 bit libraries + loclibpth="$loclibpth /usr/lib/sparcv9" + if test -n "$workshoplibs"; then + loclibpth=`echo $loclibpth | sed -e "s% $workshoplibs%%" ` + for lib in $workshoplibs; do + # Logically, it should be sparcv9. + # But the reality fights back, it's v9. + loclibpth="$loclibpth $lib/sparcv9 $lib/v9" + done + fi ;; - *) loclibpth="$loclibpth $workshoplibs" + *) loclibpth="$loclibpth $workshoplibs" ;; esac + else + loclibpth="$loclibpth $workshoplibs" + fi workshoplibpth_done="$define" ;; esac EOCBU -case "$ccisworkshop" in -"$define") - cat >try.c < -int main() { return(0); } -EOF - workshoplibs=`cc -### try.c -lsunmath -o try 2>&1|grep " -Y "|sed 's%.* -Y "P,\(.*\)".*%\1%'|tr ':' '\n'|grep '/SUNWspro/'` - . ./UU/workshoplibpth.cbu - ;; -esac - ###################################################### # General sanity testing. See below for excerpts from the Solaris FAQ. # @@ -90,12 +96,12 @@ esac # To: perl5-porters@africa.nicoh.com # Subject: Re: On perl5/solaris/gcc # -# Here's another draft of the perl5/solaris/gcc sanity-checker. +# Here's another draft of the perl5/solaris/gcc sanity-checker. case `type ${cc:-cc}` in */usr/ucb/cc*) cat <&4 -NOTE: Some people have reported problems with /usr/ucb/cc. +NOTE: Some people have reported problems with /usr/ucb/cc. If you have difficulties, please make sure the directory containing your C compiler is before /usr/ucb in your PATH. @@ -153,7 +159,7 @@ if grep GNU make.vers > /dev/null 2>&1; then case "`/usr/bin/ls -lL $tmp`" in ??????s*) cat <&2 - + NOTE: Your PATH points to GNU make, and your GNU make has the set-group-id bit set. You must either rearrange your PATH to put /usr/ccs/bin before the GNU utilities or you must ask your system administrator to disable the @@ -165,31 +171,33 @@ END fi rm -f make.vers -# XXX EXPERIMENTAL A.D. 2/27/1998 -# XXX This script UU/cc.cbu will get 'called-back' by Configure after it -# XXX has prompted the user for the C compiler to use. -cat > UU/cc.cbu <<'EOSH' +cat > UU/cc.cbu <<'EOCBU' +# This script UU/cc.cbu will get 'called-back' by Configure after it +# has prompted the user for the C compiler to use. + # If the C compiler is gcc: # - check the fixed-includes # - check as(1) and ld(1), they should not be GNU # (GNU as and ld 2.8.1 and later are reportedly ok, however.) # If the C compiler is not gcc: +# - Check if it is the Workshop/Forte compiler. +# If it is, prepare for 64 bit and long doubles. # - check as(1) and ld(1), they should not be GNU # (GNU as and ld 2.8.1 and later are reportedly ok, however.) # # Watch out in case they have not set $cc. -# Perl compiled with some combinations of GNU as and ld may not +# Perl compiled with some combinations of GNU as and ld may not # be able to perform dynamic loading of extensions. If you have a # problem with dynamic loading, be sure that you are using the Solaris # /usr/ccs/bin/as and /usr/ccs/bin/ld. You can do that with # sh Configure -Dcc='gcc -B/usr/ccs/bin/' -# (note the trailing slash is required). +# (note the trailing slash is required). # Combinations that are known to work with the following hints: # # gcc-2.7.2, GNU as 2.7, GNU ld 2.7 # egcs-1.0.3, GNU as 2.9.1 and GNU ld 2.9.1 -# --Andy Dougherty +# --Andy Dougherty # Tue Apr 13 17:19:43 EDT 1999 # Get gcc to share its secrets. @@ -202,12 +210,6 @@ if echo "$verbose" | grep '^Reading specs from' >/dev/null 2>&1; then # Using gcc. # - tmp=`echo "$verbose" | grep '^Reading' | - awk '{print $NF}' | sed 's/specs$/include/'` - - # Determine if the fixed-includes look like they'll work. - # Doesn't work anymore for gcc-2.7.2. - # See if as(1) is GNU as(1). GNU as(1) might not work for this job. if echo "$verbose" | grep ' /usr/ccs/bin/as ' >/dev/null 2>&1; then : @@ -272,6 +274,23 @@ else # Not using gcc. # + ccversion="`${cc:-cc} -V 2>&1|sed -n -e '1s/^cc: //p'`" + case "$ccversion" in + *WorkShop*) ccname=workshop ;; + *) ccversion='' ;; + esac + + case "$ccname" in + workshop) + cat >try.c < +int main() { return(0); } +EOM + workshoplibs=`cc -### try.c -lsunmath -o try 2>&1|sed -n '/ -Y /s%.* -Y "P,\(.*\)".*%\1%p'|tr ':' '\n'|grep '/SUNWspro/'` + . ./workshoplibpth.cbu + ;; + esac + # See if as(1) is GNU as(1). GNU might not work for this job. case `as --version < /dev/null 2>&1` in *GNU*) @@ -288,22 +307,12 @@ END # See if ld(1) is GNU ld(1). GNU ld(1) might not work for this job. # ld --version doesn't properly report itself as a GNU tool, # as of ld version 2.6, so we need to be more strict. TWP 9/5/96 - gnu_ld=false - case `ld --version < /dev/null 2>&1` in - *GNU*|ld\ version\ 2*) - gnu_ld=true ;; - *) ;; - esac - if $gnu_ld ; then : + # Sun's ld always emits the "Software Generation Utilities" string. + if ld -V 2>&1 | grep "ld: Software Generation Utilities" >/dev/null 2>&1; then + # Ok, ld is /usr/ccs/bin/ld. + : else - # Try to guess from path - case `type ld | awk '{print $NF}'` in - *gnu*|*GNU*|*FSF*) - gnu_ld=true ;; - esac - fi - if $gnu_ld ; then - cat <&2 + cat <&2 NOTE: You are apparently using GNU ld(1). GNU ld(1) might not build Perl. You should arrange to use /usr/ccs/bin/ld, perhaps by adding /usr/ccs/bin @@ -319,17 +328,21 @@ rm -f try try.c rm -f core # XXX -EOSH +EOCBU cat > UU/usethreads.cbu <<'EOCBU' -# This script UU/usethreads.cbu will get 'called-back' by Configure +# This script UU/usethreads.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use threads. case "$usethreads" in $define|true|[yY]*) ccflags="-D_REENTRANT $ccflags" - # sched_yield is in -lposix4 - set `echo X "$libswanted "| sed -e 's/ c / posix4 pthread c /'` + # sched_yield is in -lposix4 up to Solaris 2.6, in -lrt starting with Solaris 2.7 + case `uname -r` in + 5.[0-6] | 5.5.1) sched_yield_lib="posix4" ;; + *) sched_yield_lib="rt"; + esac + set `echo X "$libswanted "| sed -e "s/ c / $sched_yield_lib pthread c /"` shift libswanted="$*" @@ -343,18 +356,18 @@ $define|true|[yY]*) cat >try.c <<'EOM' /* Test for sig(set|long)jmp bug. */ #include - + main() { sigjmp_buf env; int ret; - + ret = sigsetjmp(env, 1); if (ret) { return ret == 2; } siglongjmp(env, 2); } EOM - if test "`arch`" = i86pc -a "$osvers" = 2.6 && \ + if test "`arch`" = i86pc -a `uname -r` = 5.6 && \ ${cc:-cc} try.c -lpthread >/dev/null 2>&1 && ./a.out; then d_sigsetjmp=$undef cat << 'EOM' >&2 @@ -370,27 +383,42 @@ esac EOCBU cat > UU/uselargefiles.cbu <<'EOCBU' -# This script UU/uselargefiles.cbu will get 'called-back' by Configure +# This script UU/uselargefiles.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use large files. case "$uselargefiles" in ''|$define|true|[yY]*) - ccflags="$ccflags `getconf LFS_CFLAGS 2>/dev/null`" - ldflags="$ldflags `getconf LFS_LDFLAGS 2>/dev/null`" - libswanted="$libswanted `getconf LFS_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" + +# Keep these in the left margin. +ccflags_uselargefiles="`getconf LFS_CFLAGS 2>/dev/null`" +ldflags_uselargefiles="`getconf LFS_LDFLAGS 2>/dev/null`" +libswanted_uselargefiles="`getconf LFS_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" + + ccflags="$ccflags $ccflags_uselargefiles" + ldflags="$ldflags $ldflags_uselargefiles" + libswanted="$libswanted $libswanted_uselargefiles" ;; esac EOCBU -cat > UU/use64bitint.cbu <<'EOCBU' -# This script UU/use64bitint.cbu will get 'called-back' by Configure +# This is truly a mess. +case "$usemorebits" in +"$define"|true|[yY]*) + use64bitint="$define" + uselongdouble="$define" + ;; +esac + +if test `uname -p` = "sparc"; then + cat > UU/use64bitint.cbu <<'EOCBU' +# This script UU/use64bitint.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use 64 bit integers. case "$use64bitint" in "$define"|true|[yY]*) case "`uname -r`" in - 2.[1-6]) + 5.[0-4]) cat >&4 < UU/use64bitall.cbu <<'EOCBU' -# This script UU/use64bitall.cbu will get 'called-back' by Configure + cat > UU/use64bitall.cbu <<'EOCBU' +# This script UU/use64bitall.cbu will get 'called-back' by Configure # after it has prompted the user for whether to be maximally 64 bitty. case "$use64bitall-$use64bitall_done" in "$define-"|true-|[yY]*-) + case "`uname -r`" in + 5.[0-6]) + cat >&4 <&4 </dev/null" in *gcc*) echo 'main() { return 0; }' > try.c - if ${cc:-cc} -mcpu=v9 -m64 -S try.c 2>&1 | grep -e \ - '-m64 is not supported by this configuration'; then + case "`${cc:-cc} -mcpu=v9 -m64 -S try.c 2>&1 | grep 'm64 is not supported by this configuration'`" in + *"m64 is not supported"*) cat >&4 </dev/null` != X; then ccflags="$ccflags -Wa,`getconf XBS5_LP64_OFF64_CFLAGS 2>/dev/null`" @@ -444,236 +485,47 @@ EOM ldflags="$ldflags `getconf XBS5_LP64_OFF64_LDFLAGS 2>/dev/null`" lddlflags="$lddlflags -G `getconf XBS5_LP64_OFF64_LDFLAGS 2>/dev/null`" ;; - esac + esac libscheck='case "`/usr/bin/file $xxx`" in *64-bit*|*SPARCV9*) ;; *) xxx=/no/64-bit$xxx ;; esac' + use64bitall_done=yes ;; esac EOCBU - -# Actually, we want to run this already now, if so requested, -# because we need to fix up things right now. -case "$use64bitall" in -"$define"|true|[yY]*) - . ./UU/use64bitall.cbu + + # Actually, we want to run this already now, if so requested, + # because we need to fix up things right now. + case "$use64bitall" in + "$define"|true|[yY]*) + # CBUs expect to be run in UU + cd UU; . ./use64bitall.cbu; cd .. ;; -esac + esac +fi cat > UU/uselongdouble.cbu <<'EOCBU' -# This script UU/uselongdouble.cbu will get 'called-back' by Configure +# This script UU/uselongdouble.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use long doubles. -case "$uselongdouble-$uselongdouble_done" in -"$define-"|true-|[yY]*-) - case "$ccisworkshop" in - '') cat >&4 <&4 < /dev/null <<'End_of_Solaris_Notes' - -Here are some notes kindly contributed by Dean Roehrich. - ------ -Generic notes about building Perl5 on Solaris: -- Use /usr/ccs/bin/make. -- If you use GNU make, remove its setgid bit. -- Remove all instances of *ucb* from your path. -- Make sure libucb is not in /usr/lib (it should be in /usr/ucblib). -- Do not use GNU as or GNU ld, or any of GNU binutils or GNU libc. -- Do not use /usr/ucb/cc. -- Do not change Configure's default answers, except for the path names. -- Do not use -lmalloc. -- Do not build on SunOS 4 and expect it to work properly on SunOS 5. -- /dev/fd must be mounted if you want set-uid scripts to work. - - -Here are the gcc-related questions and answers from the Solaris 2 FAQ. Note -the themes: - - run fixincludes - - run fixincludes correctly - - don't use GNU as or GNU ld - -Question 5.7 covers the __builtin_va_alist problem people are always seeing. -Question 6.1.3 covers the GNU as and GNU ld issues which are always biting -people. -Question 6.9 is for those who are still trying to compile Perl4. - -The latest Solaris 2 FAQ can be found in the following locations: - rtfm.mit.edu:/pub/usenet-by-group/comp.sys.sun.admin - ftp.fwi.uva.nl:/pub/solaris - -Perl5 comes with a script in the top-level directory called "myconfig" which -will print a summary of the configuration in your config.sh. My summary for -Solaris 2.4 and gcc 2.6.3 follows. I have also built with gcc 2.7.0 and the -results are identical. This configuration was generated with Configure's -d -option (take all defaults, don't bother prompting me). All tests pass for -Perl5.001, patch.1m. - -Summary of my perl5 (patchlevel 1) configuration: - Platform: - osname=solaris, osver=2.4, archname=sun4-solaris - uname='sunos poplar 5.4 generic_101945-27 sun4d sparc ' - hint=recommended - Compiler: - cc='gcc', optimize='-O', ld='gcc' - cppflags='' - ccflags ='' - ldflags ='' - stdchar='unsigned char', d_stdstdio=define, usevfork=false - voidflags=15, castflags=0, d_casti32=define, d_castneg=define - intsize=4, alignbytes=8, usemymalloc=y, randbits=15 - Libraries: - so=so - libpth=/lib /usr/lib /usr/ccs/lib /usr/local/lib - libs=-lsocket -lnsl -ldl -lm -lc -lcrypt - libc=/usr/lib/libc.so - Dynamic Linking: - dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef - cccdlflags='-fpic', ccdlflags=' ', lddlflags='-G' - - -Dean -roehrich@cray.com -9/7/95 - ------------ - -From: Casper.Dik@Holland.Sun.COM (Casper H.S. Dik - Network Security Engineer) -Subject: Solaris 2 Frequently Asked Questions (FAQ) 1.48 -Date: 25 Jul 1995 12:20:18 GMT - -5.7) Why do I get __builtin_va_alist or __builtin_va_arg_incr undefined? - - You're using gcc without properly installing the gcc fixed - include files. Or you ran fixincludes after installing gcc - w/o moving the gcc supplied varargs.h and stdarg.h files - out of the way and moving them back again later. This often - happens when people install gcc from a binary distribution. - If there's a tmp directory in gcc's include directory, fixincludes - didn't complete. You should have run "just-fixinc" instead. - - Another possible cause is using ``gcc -I/usr/include.'' - -6.1) Where is the C compiler or where can I get one? - - [...] - - 3) Gcc. - - Gcc is available from the GNU archives in source and binary - form. Look in a directory called sparc-sun-solaris2 for - binaries. You need gcc 2.3.3 or later. You should not use - GNU as or GNU ld. Make sure you run just-fixinc if you use - a binary distribution. Better is to get a binary version and - use that to bootstrap gcc from source. - - [...] - - When you install gcc, don't make the mistake of installing - GNU binutils or GNU libc, they are not as capable as their - counterparts you get with Solaris 2.x. - -6.9) I can't get perl 4.036 to compile or run. - - Run Configure, and use the solaris_2_0 hints, *don't* use - the solaris_2_1 hints and don't use the config.sh you may - already have. First you must make sure Configure and make - don't find /usr/ucb/cc. (It must use gcc or the native C - compiler: /opt/SUNWspro/bin/cc) - - Some questions need a special answer. - - Are your system (especially dbm) libraries compiled with gcc? [y] y - - yes: gcc 2.3.3 or later uses the standard calling - conventions, same as Sun's C. - - Any additional cc flags? [ -traditional -Dvolatile=__volatile__ - -I/usr/ucbinclude] -traditional -Dvolatile=__volatile__ - Remove /usr/ucbinclude. - - Any additional libraries? [-lsocket -lnsl -ldbm -lmalloc -lm - -lucb] -lsocket -lnsl -lm - - Don't include -ldbm, -lmalloc and -lucb. - - Perl 5 compiled out of the box. - -7.0) 64-bitness, from Alan Burlison (added by jhi 2000-02-21) - - You need a machine running Solaris 2.7 or above. - - Here's some rules: - - 1. Solaris 2.7 and above will run in either 32 bit or 64 bit mode, - via a reboot. - 2. You can build 64 bit apps whilst running 32 bit mode and vice-versa. - 3. 32 bit apps will run under Solaris running in either 32 or 64 bit mode. - 4. 64 bit apps require Solaris to be running 64 bit mode - 5. It is possible to select the appropriate 32 or 64 bit version of an - app at run-time using isaexec(3). - 6. You can detect the OS mode using "isainfo -v", e.g. - fubar$ isainfo -v # Ultra 30 in 64 bit mode - 64-bit sparcv9 applications - 32-bit sparc applications - 7. To compile 64 bit you need to use the flag "-xarch=v9". - getconf(1) will tell you this, e.g. - fubar$ getconf -a | grep v9 - XBS5_LP64_OFF64_CFLAGS: -xarch=v9 - XBS5_LP64_OFF64_LDFLAGS: -xarch=v9 - XBS5_LP64_OFF64_LINTFLAGS: -xarch=v9 - XBS5_LPBIG_OFFBIG_CFLAGS: -xarch=v9 - XBS5_LPBIG_OFFBIG_LDFLAGS: -xarch=v9 - XBS5_LPBIG_OFFBIG_LINTFLAGS: -xarch=v9 - _XBS5_LP64_OFF64_CFLAGS: -xarch=v9 - _XBS5_LP64_OFF64_LDFLAGS: -xarch=v9 - _XBS5_LP64_OFF64_LINTFLAGS: -xarch=v9 - _XBS5_LPBIG_OFFBIG_CFLAGS: -xarch=v9 - _XBS5_LPBIG_OFFBIG_LDFLAGS: -xarch=v9 - _XBS5_LPBIG_OFFBIG_LINTFLAGS: -xarch=v9 - - > > Now, what should we do, then? Should -Duse64bits in a v9 box cause - > > Perl to compiled in v9 mode? Or should we for compatibility stick - > > with 32 bit builds and let the people in the know to add the -xarch=v9 - > > to ccflags (and ldflags?)? - - > I think the second (explicit) mechanism should be the default. Unless - > you want to allocate more than ~ 4Gb of memory inside Perl, you don't - > need Perl to be a 64-bit app. Put it this way, on a machine running - > Solaris 8, there are 463 executables under /usr/bin, but only 15 of - > those require 64 bit versions - mainly because they invade the kernel - > address space, e.g. adb, kgmon etc. Certainly we don't recommend users - > to build 64 bit apps unless they need the address space. - -End_of_Solaris_Notes - +rm -f try.c try.o try a.out diff --git a/contrib/perl5/hints/svr4.sh b/contrib/perl5/hints/svr4.sh index 8109b3975287..69af6fda2f2f 100644 --- a/contrib/perl5/hints/svr4.sh +++ b/contrib/perl5/hints/svr4.sh @@ -135,6 +135,22 @@ case "`uname -sm`" in ;; esac +# NCR MP-RAS. Thanks to Doug Hendricks for this info. +# The output of uname -a looks like this +# foo foo 4.0 3.0 3441 Pentium III(TM)-ISA/PCI +# Configure sets osname=svr4.0, osvers=3.0, archname='3441-svr4.0' +case "$myuname" in +*3441*) + # With the NCR High Performance C Compiler R3.0c, miniperl fails + # t/op/regexp.t test 461 unless we compile with optimizie=-g. + # The whole O/S is being phased out, so more detailed probing + # is probably not warranted. + case "$optimize" in + '') optimize='-g' ;; + esac + ;; +esac + # Configure may fail to find lstat() since it's a static/inline function # in on Unisys U6000 SVR4, UnixWare 2.x, and possibly other # SVR4 derivatives. (Though UnixWare has it in /usr/ccs/lib/libc.so.) diff --git a/contrib/perl5/hints/titanos.sh b/contrib/perl5/hints/titanos.sh index cea99f82a3a2..88a3e7a96304 100644 --- a/contrib/perl5/hints/titanos.sh +++ b/contrib/perl5/hints/titanos.sh @@ -12,7 +12,6 @@ intsize='4' usenm='true' nm_opt='-eh' malloctype='void *' -models='none' ccflags="$ccflags -I/usr/include/net -DDEBUGGING -DSTANDARD_C" cppflags="$cppflags -I/usr/include/net -DDEBUGGING -DSTANDARD_C" stdchar='unsigned char' diff --git a/contrib/perl5/hints/unicos.sh b/contrib/perl5/hints/unicos.sh index 7ffd73fbcc04..089b9600e265 100644 --- a/contrib/perl5/hints/unicos.sh +++ b/contrib/perl5/hints/unicos.sh @@ -2,13 +2,21 @@ case `uname -r` in 6.1*) shellflags="-m+65536" ;; esac case "$optimize" in -'') optimize="-O1" ;; +# If we used fastmd (the default) integer values would be limited to 46 bits. +# --Mark P. Lutz +'') optimize="$optimize -h nofastmd" ;; esac -d_setregid='undef' -d_setreuid='undef' +# The default is to die in runtime on math overflows. +# Let's not do that. --jhi +ccflags="$ccflags -h matherror=errno" +# Give int((2/3)*3) a chance to be 2, not 1. --jhi +ccflags="$ccflags -h rounddiv" +# Avoid an optimizer bug where a volatile variables +# isn't correctly saved and restored --Mark P. Lutz +pp_ctl_cflags='ccflags="$ccflags -h scalar0 -h vector0"' case "$usemymalloc" in '') # The perl malloc.c SHOULD work says Ilya. - # But for the time being (5.004_68), alas, it doesn't. + # But for the time being (5.004_68), alas, it doesn't. --jhi # usemymalloc='y' # ccflags="$ccflags -DNO_RCHECK" usemymalloc='n' @@ -16,3 +24,6 @@ case "$usemymalloc" in esac # Configure gets fooled for some reason. There is no getpgid(). d_getpgid='undef' +# These exist but do not really work. +d_setregid='undef' +d_setreuid='undef' diff --git a/contrib/perl5/hints/uts.sh b/contrib/perl5/hints/uts.sh index 9ad72d7e9870..2bae4b0acf2d 100644 --- a/contrib/perl5/hints/uts.sh +++ b/contrib/perl5/hints/uts.sh @@ -1,2 +1,18 @@ -ccflags="$ccflags -DCRIPPLED_CC" -d_lstat=define +archname='s390' +cc='cc -Xa' +cccdlflags='-pic' +d_bincompat3='undef' +d_csh='undef' +d_lstat='define' +d_suidsafe='define' +dlsrc='dl_dlopen.xs' +ld='ld' +lddlflags='-G -z text' +libperl='libperl.so' +libpth='/lib /usr/lib /usr/ccs/lib' +libs='-lsocket -lnsl -ldl -lm' +optimize='undef' +prefix='psf_prefix' +static_ext='none' +dynamic_ext='Fcntl IO Opcode Socket' +useshrplib='define' diff --git a/contrib/perl5/hints/vmesa.sh b/contrib/perl5/hints/vmesa.sh index bc033878229e..0213853fec92 100644 --- a/contrib/perl5/hints/vmesa.sh +++ b/contrib/perl5/hints/vmesa.sh @@ -24,7 +24,7 @@ d_access='define' d_alarm='define' d_archlib='define' # randbits='15' -archobjs="ebcdic.o vmesa.o" +archobjs="vmesa.o" d_attribut='undef' d_bcmp='define' d_bcopy='define' @@ -294,7 +294,6 @@ make='gnumake' mallocobj='' mallocsrc='' malloctype='void *' -models='none' netdb_hlen_type='size_t' netdb_host_type='char *' netdb_name_type='const char *' diff --git a/contrib/perl5/hv.c b/contrib/perl5/hv.c index 44d37e34d300..321d403ca2f0 100644 --- a/contrib/perl5/hv.c +++ b/contrib/perl5/hv.c @@ -1,6 +1,6 @@ /* hv.c * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -42,9 +42,14 @@ S_more_he(pTHX) { register HE* he; register HE* heend; - New(54, PL_he_root, 1008/sizeof(HE), HE); - he = PL_he_root; + XPV *ptr; + New(54, ptr, 1008/sizeof(XPV), XPV); + ptr->xpv_pv = (char*)PL_he_arenaroot; + PL_he_arenaroot = ptr; + + he = (HE*)ptr; heend = &he[1008 / sizeof(HE) - 1]; + PL_he_root = ++he; while (he < heend) { HeNEXT(he) = (HE*)(he + 1); he++; @@ -144,7 +149,6 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, U32 klen, I32 lval) if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { - dTHR; sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); PL_hv_fetch_sv = sv; @@ -241,7 +245,6 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash) if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { - dTHR; sv = sv_newmortal(); keysv = sv_2mortal(newSVsv(keysv)); mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); @@ -458,7 +461,6 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash) xhv = (XPVHV*)SvANY(hv); if (SvMAGICAL(hv)) { - dTHR; bool needs_copy; bool needs_store; hv_magic_check (hv, &needs_copy, &needs_store); @@ -716,7 +718,6 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, U32 klen) if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { - dTHR; sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); magic_existspack(sv, mg_find(sv, 'p')); @@ -792,7 +793,6 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { - dTHR; /* just for SvTRUE */ sv = sv_newmortal(); keysv = sv_2mortal(newSVsv(keysv)); mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); @@ -1045,8 +1045,8 @@ Perl_newHVhv(pTHX_ HV *ohv) /* Slow way */ hv_iterinit(ohv); while ((entry = hv_iternext(ohv))) { - hv_store(hv, HeKEY(entry), HeKLEN(entry), - SvREFCNT_inc(HeVAL(entry)), HeHASH(entry)); + hv_store(hv, HeKEY(entry), HeKLEN(entry), + newSVsv(HeVAL(entry)), HeHASH(entry)); } HvRITER(ohv) = hv_riter; HvEITER(ohv) = hv_eiter; @@ -1444,12 +1444,8 @@ Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash) break; } UNLOCK_STRTAB_MUTEX; - - { - dTHR; - if (!found && ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string"); - } + if (!found && ckWARN_d(WARN_INTERNAL)) + Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string"); } /* get a (constant) string ptr from the global string table diff --git a/contrib/perl5/hv.h b/contrib/perl5/hv.h index 5bc38a0a79ae..6830d65f70b4 100644 --- a/contrib/perl5/hv.h +++ b/contrib/perl5/hv.h @@ -1,27 +1,31 @@ /* hv.h * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * */ +/* typedefs to eliminate some typing */ typedef struct he HE; typedef struct hek HEK; +/* entry in hash value chain */ struct he { - HE *hent_next; - HEK *hent_hek; - SV *hent_val; + HE *hent_next; /* next entry in chain */ + HEK *hent_hek; /* hash key */ + SV *hent_val; /* scalar value that was hashed */ }; +/* hash key -- defined separately for use as shared pointer */ struct hek { - U32 hek_hash; - I32 hek_len; - char hek_key[1]; + U32 hek_hash; /* hash of key */ + I32 hek_len; /* length of hash key */ + char hek_key[1]; /* variable-length hash key */ }; +/* hash structure: */ /* This structure must match the beginning of struct xpvmg in sv.h. */ struct xpvhv { char * xhv_array; /* pointer to malloced string */ @@ -38,6 +42,7 @@ struct xpvhv { char *xhv_name; /* name, if a symbol table */ }; +/* hash a key */ #define PERL_HASH(hash,str,len) \ STMT_START { \ register const char *s_PeRlHaSh = str; \ @@ -171,6 +176,7 @@ C. #define HEK_LEN(hek) (hek)->hek_len #define HEK_KEY(hek) (hek)->hek_key +/* calculate HV array allocation */ #if defined(STRANGE_MALLOC) || defined(MYMALLOC) # define PERL_HV_ARRAY_ALLOC_BYTES(size) ((size) * sizeof(HE*)) #else diff --git a/contrib/perl5/installhtml b/contrib/perl5/installhtml index cfbbe9f5c67a..d437ded13c0b 100755 --- a/contrib/perl5/installhtml +++ b/contrib/perl5/installhtml @@ -1,6 +1,6 @@ #!./perl -w -# This file should really be a extracted from a .PL +# This file should really be extracted from a .PL file use lib 'lib'; # use source library if present @@ -592,6 +592,7 @@ sub runpod2html { "--htmlroot=$htmlroot", "--podpath=".join(":", @podpath), "--podroot=$podroot", "--netscape", + "--header", ($doindex ? "--index" : "--noindex"), "--" . ($recurse ? "" : "no") . "recurse", ($#libpods >= 0) ? "--libpods=" . join(":", @libpods) : "", diff --git a/contrib/perl5/installman b/contrib/perl5/installman index c9fb0fe18cbf..06f68f5dddfe 100755 --- a/contrib/perl5/installman +++ b/contrib/perl5/installman @@ -1,5 +1,6 @@ -#!./perl +#!./perl -w BEGIN { @INC = ('lib') } +use strict; use Config; use Getopt::Long; use File::Find; @@ -7,40 +8,52 @@ use File::Copy; use File::Path qw(mkpath); use ExtUtils::Packlist; use subs qw(unlink chmod rename link); -use vars qw($packlist); +use vars qw($packlist @modpods); require Cwd; $ENV{SHELL} = 'sh' if $^O eq 'os2'; -$ver = $Config{version}; -$release = substr($],0,3); # Not used presently. -$patchlevel = substr($],3,2); +my $ver = $Config{version}; # Not used presently. +my $release = substr($],0,3); # Not used presently. +my $patchlevel = substr($],3,2); die "Patchlevel of perl ($patchlevel)", "and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n" if $patchlevel != $Config{'PERL_VERSION'}; -$usage = +my $usage = "Usage: installman --man1dir=/usr/wherever --man1ext=1 - --man3dir=/usr/wherever --man3ext=3 - --notify --help + --man3dir=/usr/wherever --man3ext=3 + --batchlimit=40 + --notify --verbose --silent --help Defaults are: man1dir = $Config{'installman1dir'}; man1ext = $Config{'man1ext'}; man3dir = $Config{'installman3dir'}; man3ext = $Config{'man3ext'}; - --notify (or -n) just lists commands that would be executed.\n"; + batchlimit is maximum number of pod files per invocation of pod2man + --notify (or -n) just lists commands that would be executed. + --verbose (or -V) report all progress. + --silent (or -S) be silent. Only report errors.\n"; -GetOptions( qw( man1dir=s man1ext=s man3dir=s man3ext=s notify n help)) +my %opts; +GetOptions( \%opts, + qw( man1dir=s man1ext=s man3dir=s man3ext=s batchlimit=i + notify n help silent S verbose V)) || die $usage; -die $usage if $opt_help; +die $usage if $opts{help}; -# These are written funny to avoid -w typo warnings. -$man1dir = defined($opt_man1dir) ? $opt_man1dir : $Config{'installman1dir'}; -$man1ext = defined($opt_man1ext) ? $opt_man1ext : $Config{'man1ext'}; -$man3dir = defined($opt_man3dir) ? $opt_man3dir : $Config{'installman3dir'}; -$man3ext = defined($opt_man3ext) ? $opt_man3ext : $Config{'man3ext'}; - -$notify = $opt_notify || $opt_n; +$opts{man1dir} = $Config{'installman1dir'} + unless defined($opts{man1dir}); +$opts{man1ext} = $Config{'man1ext'} + unless defined($opts{man1ext}); +$opts{man3dir} = $Config{'installman3dir'} + unless defined($opts{man3dir}); +$opts{man3ext} = $Config{'man3ext'} + unless defined($opts{man3ext}); +$opts{batchlimit} ||= 40; +$opts{silent} ||= $opts{S}; +$opts{notify} ||= $opts{n}; +$opts{verbose} ||= $opts{V} || $opts{notify}; #Sanity checks @@ -55,42 +68,30 @@ $notify = $opt_notify || $opt_n; $packlist = ExtUtils::Packlist->new("$Config{installarchlib}/.packlist"); # Install the main pod pages. -runpod2man('pod', $man1dir, $man1ext); +runpod2man('pod', $opts{man1dir}, $opts{man1ext}); # Install the pods for library modules. -runpod2man('lib', $man3dir, $man3ext); +runpod2man('lib', $opts{man3dir}, $opts{man3ext}); # Install the pods embedded in the installed scripts -runpod2man('utils', $man1dir, $man1ext, 'c2ph'); -runpod2man('utils', $man1dir, $man1ext, 'h2ph'); -runpod2man('utils', $man1dir, $man1ext, 'h2xs'); -runpod2man('utils', $man1dir, $man1ext, 'perlcc'); -runpod2man('utils', $man1dir, $man1ext, 'perldoc'); -runpod2man('utils', $man1dir, $man1ext, 'perlbug'); -runpod2man('utils', $man1dir, $man1ext, 'pl2pm'); -runpod2man('utils', $man1dir, $man1ext, 'splain'); -runpod2man('utils', $man1dir, $man1ext, 'dprofpp'); -runpod2man('x2p', $man1dir, $man1ext, 's2p'); -runpod2man('x2p', $man1dir, $man1ext, 'a2p.pod'); -runpod2man('x2p', $man1dir, $man1ext, 'find2perl'); -runpod2man('pod', $man1dir, $man1ext, 'pod2man'); -runpod2man('pod', $man1dir, $man1ext, 'pod2html'); -runpod2man('pod', $man1dir, $man1ext, 'pod2text'); -runpod2man('pod', $man1dir, $man1ext, 'pod2usage'); -runpod2man('pod', $man1dir, $man1ext, 'podchecker'); -runpod2man('pod', $man1dir, $man1ext, 'podselect'); +runpod2man('utils', $opts{man1dir}, $opts{man1ext}, 'c2ph', 'h2ph', 'h2xs', + 'perlcc', 'perldoc', 'perlbug', 'pl2pm', 'splain', 'dprofpp'); +runpod2man('x2p', $opts{man1dir}, $opts{man1ext}, 's2p', 'a2p.pod', + 'find2perl'); +runpod2man('pod', $opts{man1dir}, $opts{man1ext}, 'pod2man', 'pod2html', + 'pod2text', 'pod2usage', 'podchecker', 'podselect'); # It would probably be better to have this page linked # to the c2ph man page. Or, this one could say ".so man1/c2ph.1", -# but then it would have to pay attention to $man1dir and $man1ext. -runpod2man('utils', $man1dir, $man1ext, 'pstruct'); +# but then it would have to pay attention to $opts{man1dir} and $opts{man1ext}. +runpod2man('utils', $opts{man1dir}, $opts{man1ext}, 'pstruct'); -runpod2man('lib/ExtUtils', $man1dir, $man1ext, 'xsubpp'); +runpod2man('lib/ExtUtils', $opts{man1dir}, $opts{man1ext}, 'xsubpp'); sub runpod2man { - # $script is script name if we are installing a manpage embedded - # in a script, undef otherwise - my($poddir, $mandir, $manext, $script) = @_; + # @script is scripts names if we are installing manpages embedded + # in scripts, () otherwise + my($poddir, $mandir, $manext, @script) = @_; my($downdir); # can't just use .. when installing xsubpp manpage @@ -99,12 +100,16 @@ sub runpod2man { my($builddir) = Cwd::getcwd(); if ($mandir eq ' ' or $mandir eq '') { - print STDERR "Skipping installation of ", - ($script ? "$poddir/$script man page" : "$poddir man pages"), ".\n"; + if (@script) { + warn "Skipping installation of $poddir/$_ man page.\n" + foreach @script; + } else { + warn "Skipping installation of $poddir man pages.\n"; + } return; } - print STDERR "chdir $poddir\n"; + print "chdir $poddir\n" if $opts{verbose}; chdir $poddir || die "Unable to cd to $poddir directory!\n$!\n"; # We insist on using the current version of pod2man in case there @@ -118,21 +123,22 @@ sub runpod2man { # yet. (The user may have set the $install* Configure variables # to point to some temporary home, from which the executable gets # installed by occult means.) - $pod2man = "$downdir/perl -I $downdir/lib $downdir/pod/pod2man --section=$manext --official"; + my $pod2man = "$downdir/perl -I $downdir/lib $downdir/pod/pod2man --section=$manext --official"; - mkpath($mandir, 1, 0777) unless $notify; # In File::Path + mkpath($mandir, $opts{verbose}, 0777) unless $opts{notify}; # In File::Path # Make a list of all the .pm and .pod files in the directory. We will # always run pod2man from the lib directory and feed it the full pathname # of the pod. This might be useful for pod2man someday. - if ($script) { - @modpods = ($script); + if (@script) { + @modpods = @script; } else { @modpods = (); - find(\&lsmodpods, '.'); + File::Find::find(\&lsmodpods, '.'); } - foreach $mod (@modpods) { - $manpage = $mod; + my @to_process; + foreach my $mod (@modpods) { + my $manpage = $mod; my $tmp; # Skip .pm files that have corresponding .pod files, and Functions.pm. next if (($tmp = $mod) =~ s/\.pm$/.pod/ && -f $tmp); @@ -149,18 +155,28 @@ sub runpod2man { } $tmp = "${mandir}/${manpage}.tmp"; $manpage = "${mandir}/${manpage}.${manext}"; - if (&cmd("$pod2man $mod > $tmp") == 0 && !$notify && -s $tmp) { - if (rename($tmp, $manpage)) { - $packlist->{$manpage} = { type => 'file' }; - next; + push @to_process, [$mod, $tmp, $manpage]; + } + # Don't do all pods in same command to avoid busting command line limits + while (my @this_batch = splice @to_process, 0, $opts{batchlimit}) { + my $cmd = join " ", $pod2man, map "$$_[0] $$_[1]", @this_batch; + if (&cmd($cmd) == 0 && !$opts{notify}) { + foreach (@this_batch) { + my (undef, $tmp, $manpage) = @$_; + if (-s $tmp) { + if (rename($tmp, $manpage)) { + $packlist->{$manpage} = { type => 'file' }; + next; + } + } + unless ($opts{notify}) { + unlink($tmp); + } } } - unless ($notify) { - unlink($tmp); - } } chdir "$builddir" || die "Unable to cd back to $builddir directory!\n$!\n"; - print STDERR "chdir $builddir\n"; + print " chdir $builddir\n" if $opts{verbose}; } sub lsmodpods { @@ -172,8 +188,8 @@ sub lsmodpods { } } -$packlist->write() unless $notify; -print STDERR " Installation complete\n"; +$packlist->write() unless $opts{notify}; +print " Installation complete\n" if $opts{verbose}; exit 0; @@ -182,9 +198,9 @@ exit 0; # Utility subroutines from installperl sub cmd { - local($cmd) = @_; - print STDERR " $cmd\n"; - unless ($notify) { + my ($cmd) = @_; + print " $cmd\n" if $opts{verbose}; + unless ($opts{notify}) { if ($Config{d_fork}) { fork ? wait : exec $cmd; # Allow user to ^C out of command. } @@ -197,15 +213,15 @@ sub cmd { } sub unlink { - local(@names) = @_; + my(@names) = @_; my $cnt = 0; - foreach $name (@names) { + foreach my $name (@names) { next unless -e $name; chmod 0777, $name if $^O eq 'os2'; - print STDERR " unlink $name\n"; + print " unlink $name\n" if $opts{verbose}; ( CORE::unlink($name) and ++$cnt - or warn "Couldn't unlink $name: $!\n" ) unless $notify; + or warn "Couldn't unlink $name: $!\n" ) unless $opts{notify}; } return $cnt; } @@ -214,26 +230,26 @@ sub link { my($from,$to) = @_; my($success) = 0; - print STDERR " ln $from $to\n"; + print $opts{verbose} ? " ln $from $to\n" : " $to\n" unless $opts{silent}; eval { CORE::link($from, $to) ? $success++ : ($from =~ m#^/afs/# || $to =~ m#^/afs/#) ? die "AFS" # okay inside eval {} : warn "Couldn't link $from to $to: $!\n" - unless $notify; + unless $opts{notify}; }; if ($@) { File::Copy::copy($from, $to) ? $success++ : warn "Couldn't copy $from to $to: $!\n" - unless $notify; + unless $opts{notify}; } $success; } sub rename { - local($from,$to) = @_; + my($from,$to) = @_; if (-f $to and not unlink($to)) { my($i); for ($i = 1; $i < 50; $i++) { @@ -247,16 +263,16 @@ sub rename { } sub chmod { - local($mode,$name) = @_; + my($mode,$name) = @_; - printf STDERR " chmod %o %s\n", $mode, $name; + printf " chmod %o %s\n", $mode, $name if $opts{verbose}; CORE::chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n",$mode,$name) - unless $notify; + unless $opts{notify}; } sub samepath { - local($p1, $p2) = @_; - local($dev1, $ino1, $dev2, $ino2); + my($p1, $p2) = @_; + my($dev1, $ino1, $dev2, $ino2); if ($p1 ne $p2) { ($dev1, $ino1) = stat($p1); diff --git a/contrib/perl5/installperl b/contrib/perl5/installperl index b2ddc84c2444..d28027ce3575 100755 --- a/contrib/perl5/installperl +++ b/contrib/perl5/installperl @@ -8,7 +8,9 @@ BEGIN { } use strict; -use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $nonono $dostrip $versiononly $depth); +my ($Is_VMS, $Is_W32, $Is_OS2, $Is_Cygwin, $nonono, $dostrip, + $versiononly, $silent, $verbose, $otherperls); +use vars qw /$depth/; BEGIN { $Is_VMS = $^O eq 'VMS'; @@ -27,7 +29,6 @@ use File::Path (); use ExtUtils::Packlist; use Config; use subs qw(unlink link chmod); -use vars qw($packlist); # override the ones in the rest of the script sub mkpath { @@ -48,13 +49,19 @@ my $perl_verbase = defined($ENV{PERLNAME_VERBASE}) ? $ENV{PERLNAME_VERBASE} : $perl; +$otherperls = 1; while (@ARGV) { $nonono = 1 if $ARGV[0] eq '-n'; $dostrip = 1 if $ARGV[0] eq '-s'; $versiononly = 1 if $ARGV[0] eq '-v'; + $silent = 1 if $ARGV[0] eq '-S'; + $otherperls = 0 if $ARGV[0] eq '-o'; + $verbose = 1 if $ARGV[0] eq '-V' || $ARGV [0] eq '-n'; shift; } +$versiononly = 1 if $Config{versiononly}; + my @scripts = qw(utils/c2ph utils/h2ph utils/h2xs utils/perlbug utils/perldoc utils/pl2pm utils/splain utils/perlcc utils/dprofpp x2p/s2p x2p/find2perl @@ -109,7 +116,7 @@ find(sub { # print "[$_]\n" for sort keys %archpms; my $ver = $Config{version}; -my $release = substr($],0,3); # Not used presently. +my $release = substr($],0,3); # Not used currently. my $patchlevel = substr($],3,2); die "Patchlevel of perl ($patchlevel)", "and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n" @@ -129,6 +136,15 @@ my $libperl = $Config{libperl}; my $so = $Config{so}; my $dlext = $Config{dlext}; my $dlsrc = $Config{dlsrc}; +if ($^O eq 'os390') { + my $usedl = $Config{usedl}; + if ($usedl eq 'define') { + my $pwd; + chomp($pwd=`pwd`); + my $archlibexp = $Config{archlibexp}; + `./$^X -p -e 's{$pwd\/libperl.x}{$archlibexp/CORE/libperl.x}' lib/Config.pm`; + } +} my $d_dosuid = $Config{d_dosuid}; my $binexp = $Config{binexp}; @@ -146,7 +162,7 @@ if ($Is_VMS) { # Hang in there until File::Spec hits the big time if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; } $installbin || die "No installbin directory in config.sh\n"; --d $installbin || mkpath($installbin, 1, 0777); +-d $installbin || mkpath($installbin, $verbose, 0777); -d $installbin || $nonono || die "$installbin is not a directory\n"; -w $installbin || $nonono || die "$installbin is not writable by you\n" unless $installbin =~ m#^/afs/# || $nonono; @@ -154,36 +170,36 @@ if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; } -x 'perl' . $exe_ext || die "perl isn't executable!\n"; -x 'suidperl' . $exe_ext|| die "suidperl isn't executable!\n" if $d_dosuid; --x 't/TEST' || $Is_W32 +-f 't/rantests' || $Is_W32 || warn "WARNING: You've never run 'make test'!!!", " (Installing anyway.)\n"; if ($Is_W32 or $Is_Cygwin) { my $perldll; -if ($Is_Cygwin) { - $perldll = $libperl; - $perldll =~ s/(\..*)?$/.$dlext/; - if ($Config{useshrplib} eq 'true') { - # install ld2 and perlld as well - foreach ('ld2', 'perlld') { - safe_unlink("$installbin/$_"); - copy("$_", "$installbin/$_"); - chmod(0755, "$installbin/$_"); + if ($Is_Cygwin) { + $perldll = $libperl; + $perldll =~ s/(\..*)?$/.$dlext/; + if ($Config{useshrplib} eq 'true') { + # install ld2 and perlld as well + foreach ('ld2', 'perlld') { + safe_unlink("$installbin/$_"); + copy("$_", "$installbin/$_"); + chmod(0755, "$installbin/$_"); + }; }; - }; -} else { - $perldll = 'perl56.' . $dlext; -} + } else { + $perldll = 'perl56.' . $dlext; + } - if ($dlsrc ne "dl_none.xs") { - -f $perldll || die "No perl DLL built\n"; - } -# Install the DLL + if ($dlsrc ne "dl_none.xs") { + -f $perldll || die "No perl DLL built\n"; + } + # Install the DLL - safe_unlink("$installbin/$perldll"); - copy("$perldll", "$installbin/$perldll"); - chmod(0755, "$installbin/$perldll"); + safe_unlink("$installbin/$perldll"); + copy("$perldll", "$installbin/$perldll"); + chmod(0755, "$installbin/$perldll"); } # if ($Is_W32 or $Is_Cygwin) @@ -231,10 +247,10 @@ if ($d_dosuid) { my ($do_installarchlib, $do_installprivlib) = (0, 0); -mkpath($installprivlib, 1, 0777); -mkpath($installarchlib, 1, 0777); -mkpath($installsitelib, 1, 0777) if ($installsitelib); -mkpath($installsitearch, 1, 0777) if ($installsitearch); +mkpath($installprivlib, $verbose, 0777); +mkpath($installarchlib, $verbose, 0777); +mkpath($installsitelib, $verbose, 0777) if ($installsitelib); +mkpath($installsitearch, $verbose, 0777) if ($installsitearch); if (chdir "lib") { $do_installarchlib = ! samepath($installarchlib, '.'); @@ -251,12 +267,12 @@ else { } # Install header files and libraries. -mkpath("$installarchlib/CORE", 1, 0777); +mkpath("$installarchlib/CORE", $verbose, 0777); my @corefiles; if ($Is_VMS) { # We did core file selection during build - my $coredir = "lib/$Config{'arch'}/$ver"; + my $coredir = "lib/$Config{archname}/$ver/CORE"; $coredir =~ tr/./_/; - @corefiles = map { s|^$coredir/||i; } <$coredir/*.*>; + map { s|^$coredir/||i; } @corefiles = <$coredir/*.*>; } else { # [als] hard-coded 'libperl' name... not good! @@ -266,7 +282,7 @@ else { push(@corefiles,'perl.exp') if $^O eq 'aix'; if ($^O eq 'mpeix') { # MPE needs mpeixish.h installed as well. - mkpath("$installarchlib/CORE/mpeix", 1, 0777); + mkpath("$installarchlib/CORE/mpeix", $verbose, 0777); push(@corefiles,'mpeix/mpeixish.h'); } # If they have built sperl.o... @@ -307,7 +323,7 @@ if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VM my $mainperl_is_instperl = 0; -if ($Config{installusrbinperl} eq 'define' && +if ($Config{installusrbinperl} && $Config{installusrbinperl} eq 'define' && !$versiononly && !$nonono && !$Is_W32 && !$Is_VMS && -t STDIN && -t STDERR && -w $mainperldir && ! samepath($mainperldir, $installbin)) { my($usrbinperl) = "$mainperldir/$perl$exe_ext"; @@ -359,26 +375,25 @@ if (! $versiononly && (-f 'cppstdin') && (! samepath($installbin, '.'))) { chmod(0755, "$installbin/cppstdin"); } -# Install scripts. - -mkpath($installscript, 1, 0777); - if (! $versiononly) { + # Install scripts. + + mkpath($installscript, $verbose, 0777); + for (@scripts) { (my $base = $_) =~ s#.*/##; copy($_, "$installscript/$base"); chmod(0755, "$installscript/$base"); } -} -# pstruct should be a link to c2ph - -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"); + copy("$installscript/c2ph$scr_ext", + "$installscript/pstruct$scr_ext"); } else { - link("$installscript/c2ph$scr_ext", "$installscript/pstruct$scr_ext"); + link("$installscript/c2ph$scr_ext", + "$installscript/pstruct$scr_ext"); } } @@ -386,8 +401,8 @@ if (! $versiononly) { # ($installprivlib/pods for cygwin). my $pod = $Is_Cygwin ? 'pods' : 'pod'; -unless ( $versiononly && !($installprivlib =~ m/\Q$ver/)) { - mkpath("${installprivlib}/$pod", 1, 0777); +if ( !$versiononly || ($installprivlib =~ m/\Q$ver/)) { + mkpath("${installprivlib}/$pod", $verbose, 0777); # If Perl 5.003's perldiag.pod is there, rename it. if (open POD, "${installprivlib}/$pod/perldiag.pod") { @@ -418,7 +433,7 @@ unless ( $versiononly && !($installprivlib =~ m/\Q$ver/)) { # Also skip $mainperl if the user opted to have it be a link to the # installed perl. -if (!$versiononly) { +if (!$versiononly && $otherperls) { my ($path, @path); my $dirsep = ($Is_OS2 || $Is_W32) ? ';' : ':' ; ($path = $ENV{"PATH"}) =~ s:\\:/:g ; @@ -444,18 +459,18 @@ if (!$versiononly) { if (-x $otherperl && ! -d $otherperl); } if (@otherperls) { - print STDERR "\nWarning: $perl appears in your path in the following " . + warn "\nWarning: $perl appears in your path in the following " . "locations beyond where\nwe just installed it:\n"; for (@otherperls) { - print STDERR " ", $_, "\n"; + warn " ", $_, "\n"; } - print STDERR "\n"; + warn "\n"; } } $packlist->write() unless $nonono; -print " Installation complete\n"; +print " Installation complete\n" if $verbose; exit 0; @@ -465,7 +480,7 @@ sub yn { my($prompt) = @_; my($answer); my($default) = $prompt =~ m/\[([yn])\]\s*$/i; - print $prompt; + warn $prompt; chop($answer = ); $answer = $default if $answer =~ m/^\s*$/; ($answer =~ m/^[yY]/); @@ -480,7 +495,7 @@ sub unlink { foreach my $name (@names) { next unless -e $name; chmod 0777, $name if ($Is_OS2 || $Is_W32 || $Is_Cygwin); - print " unlink $name\n"; + print " unlink $name\n" if $verbose; ( CORE::unlink($name) and ++$cnt or warn "Couldn't unlink $name: $!\n" ) unless $nonono; } @@ -493,11 +508,11 @@ sub safe_unlink { foreach my $name (@names) { next unless -e $name; chmod 0777, $name if ($Is_OS2 || $Is_W32); - print " unlink $name\n"; + print " unlink $name\n" if $verbose; next if CORE::unlink($name); warn "Couldn't unlink $name: $!\n"; if ($! =~ /busy/i) { - print " mv $name $name.old\n"; + print " mv $name $name.old\n" if $verbose; safe_rename($name, "$name.old") or warn "Couldn't rename $name: $!\n"; } @@ -522,7 +537,7 @@ sub link { my($from,$to) = @_; my($success) = 0; - print " ln $from $to\n"; + print $verbose ? " ln $from $to\n" : " $to\n" unless $silent; eval { CORE::link($from, $to) ? $success++ @@ -534,8 +549,9 @@ sub link { }; if ($@) { warn $@; - print " cp $from $to\n"; - print " creating new version of $to\n" if $Is_VMS and -e $to; + print $verbose ? " cp $from $to\n" : " $to\n" unless $silent; + print " creating new version of $to\n" + if $Is_VMS and -e $to and !$silent; File::Copy::copy($from, $to) ? $success++ : warn "Couldn't copy $from to $to: $!\n" @@ -549,7 +565,7 @@ sub chmod { my($mode,$name) = @_; return if ($^O eq 'dos'); - printf " chmod %o %s\n", $mode, $name; + printf " chmod %o %s\n", $mode, $name if $verbose; CORE::chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n", $mode, $name) unless $nonono; @@ -558,8 +574,8 @@ sub chmod { sub copy { my($from,$to) = @_; - print " cp $from $to\n"; - print " creating new version of $to\n" if $Is_VMS and -e $to; + print $verbose ? " cp $from $to\n" : " $to\n" unless $silent; + print " creating new version of $to\n" if $Is_VMS and -e $to and !$silent; File::Copy::copy($from, $to) || warn "Couldn't copy $from to $to: $!\n" unless $nonono; @@ -624,7 +640,7 @@ sub installlib { $packlist->{"$installlib/$name"} = { type => 'file' }; if (compare($_, "$installlib/$name") || $nonono) { unlink("$installlib/$name"); - mkpath("$installlib/$dir", 1, 0777); + mkpath("$installlib/$dir", $verbose, 0777); # HP-UX (at least) needs to maintain execute permissions # on dynamically-loaded libraries. copy_if_diff($_, "$installlib/$name") @@ -677,10 +693,10 @@ sub strip foreach my $file (@args) { if (-f $file) { - print " strip $file\n"; + print " strip $file\n" if $verbose; system("strip", @opts, $file); } else { - print "# file '$file' skipped\n"; + print "# file '$file' skipped\n" if $verbose; } } } diff --git a/contrib/perl5/intrpvar.h b/contrib/perl5/intrpvar.h index 39d14c985e4d..57f31bbe1f11 100644 --- a/contrib/perl5/intrpvar.h +++ b/contrib/perl5/intrpvar.h @@ -34,7 +34,7 @@ PERLVAR(Iminus_F, bool) PERLVAR(Idoswitches, bool) /* -=for apidoc Amn|bool|PL_dowarn +=for apidoc mn|bool|PL_dowarn The C variable which corresponds to Perl's $^W warning variable. @@ -89,20 +89,20 @@ PERLVAR(IDBgv, GV *) PERLVAR(IDBline, GV *) /* -=for apidoc Amn|GV *|PL_DBsub +=for apidoc mn|GV *|PL_DBsub When Perl is run in debugging mode, with the B<-d> switch, this GV contains the SV which holds the name of the sub being debugged. This is the C variable which corresponds to Perl's $DB::sub variable. See C. -=for apidoc Amn|SV *|PL_DBsingle +=for apidoc mn|SV *|PL_DBsingle When Perl is run in debugging mode, with the B<-d> switch, this SV is a boolean which indicates whether subs are being single-stepped. Single-stepping is automatically turned on after every step. This is the C variable which corresponds to Perl's $DB::single variable. See C. -=for apidoc Amn|SV *|PL_DBtrace +=for apidoc mn|SV *|PL_DBtrace Trace variable used when Perl is run in debugging mode, with the B<-d> switch. This is the C variable which corresponds to Perl's $DB::trace variable. See C. @@ -245,19 +245,19 @@ PERLVARI(Ish_path, char *, SH_PATH)/* full path of shell */ PERLVAR(Isighandlerp, Sighandler_t) PERLVAR(Ixiv_arenaroot, XPV*) /* list of allocated xiv areas */ -PERLVAR(Ixiv_root, IV *) /* free xiv list--shared by interpreters */ -PERLVAR(Ixnv_root, NV *) /* free xnv list--shared by interpreters */ -PERLVAR(Ixrv_root, XRV *) /* free xrv list--shared by interpreters */ -PERLVAR(Ixpv_root, XPV *) /* free xpv list--shared by interpreters */ -PERLVAR(Ixpviv_root, XPVIV *) /* free xpviv list--shared by interpreters */ -PERLVAR(Ixpvnv_root, XPVNV *) /* free xpvnv list--shared by interpreters */ -PERLVAR(Ixpvcv_root, XPVCV *) /* free xpvcv list--shared by interpreters */ -PERLVAR(Ixpvav_root, XPVAV *) /* free xpvav list--shared by interpreters */ -PERLVAR(Ixpvhv_root, XPVHV *) /* free xpvhv list--shared by interpreters */ -PERLVAR(Ixpvmg_root, XPVMG *) /* free xpvmg list--shared by interpreters */ -PERLVAR(Ixpvlv_root, XPVLV *) /* free xpvlv list--shared by interpreters */ -PERLVAR(Ixpvbm_root, XPVBM *) /* free xpvbm list--shared by interpreters */ -PERLVAR(Ihe_root, HE *) /* free he list--shared by interpreters */ +PERLVAR(Ixiv_root, IV *) /* free xiv list */ +PERLVAR(Ixnv_root, NV *) /* free xnv list */ +PERLVAR(Ixrv_root, XRV *) /* free xrv list */ +PERLVAR(Ixpv_root, XPV *) /* free xpv list */ +PERLVAR(Ixpviv_root, XPVIV *) /* free xpviv list */ +PERLVAR(Ixpvnv_root, XPVNV *) /* free xpvnv list */ +PERLVAR(Ixpvcv_root, XPVCV *) /* free xpvcv list */ +PERLVAR(Ixpvav_root, XPVAV *) /* free xpvav list */ +PERLVAR(Ixpvhv_root, XPVHV *) /* free xpvhv list */ +PERLVAR(Ixpvmg_root, XPVMG *) /* free xpvmg list */ +PERLVAR(Ixpvlv_root, XPVLV *) /* free xpvlv list */ +PERLVAR(Ixpvbm_root, XPVBM *) /* free xpvbm list */ +PERLVAR(Ihe_root, HE *) /* free he list */ PERLVAR(Inice_chunk, char *) /* a nice chunk of memory to reuse */ PERLVAR(Inice_chunk_size, U32) /* how nice the chunk of memory is */ @@ -363,8 +363,8 @@ PERLVARI(Inumeric_standard, bool, TRUE) /* Assume simple numerics */ PERLVARI(Inumeric_local, bool, TRUE) /* Assume local numerics */ -PERLVAR(Inumeric_radix, char) - /* The radix character if not '.' */ +PERLVAR(Idummy1_bincompat, char) + /* Used to be numeric_radix */ #endif /* !USE_LOCALE_NUMERIC */ @@ -443,3 +443,33 @@ PERLVAR(IProc, struct IPerlProc*) #if defined(USE_ITHREADS) PERLVAR(Iptr_table, PTR_TBL_t*) #endif +PERLVARI(Ibeginav_save, AV*, Nullav) /* save BEGIN{}s when compiling */ + +#ifdef USE_THREADS +PERLVAR(Ifdpid_mutex, perl_mutex) /* mutex for fdpid array */ +PERLVAR(Isv_lock_mutex, perl_mutex) /* mutex for SvLOCK macro */ +#endif + +PERLVAR(Inullstash, HV *) /* illegal symbols end up here */ + +PERLVAR(Ixnv_arenaroot, XPV*) /* list of allocated xnv areas */ +PERLVAR(Ixrv_arenaroot, XPV*) /* list of allocated xrv areas */ +PERLVAR(Ixpv_arenaroot, XPV*) /* list of allocated xpv areas */ +PERLVAR(Ixpviv_arenaroot,XPVIV*) /* list of allocated xpviv areas */ +PERLVAR(Ixpvnv_arenaroot,XPVNV*) /* list of allocated xpvnv areas */ +PERLVAR(Ixpvcv_arenaroot,XPVCV*) /* list of allocated xpvcv areas */ +PERLVAR(Ixpvav_arenaroot,XPVAV*) /* list of allocated xpvav areas */ +PERLVAR(Ixpvhv_arenaroot,XPVHV*) /* list of allocated xpvhv areas */ +PERLVAR(Ixpvmg_arenaroot,XPVMG*) /* list of allocated xpvmg areas */ +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 */ + +#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 + * irrelevant, but not all code may be expected to #include XSUB.h. */ diff --git a/contrib/perl5/iperlsys.h b/contrib/perl5/iperlsys.h index f36dcd5f32ac..2f08a24c68e4 100644 --- a/contrib/perl5/iperlsys.h +++ b/contrib/perl5/iperlsys.h @@ -186,13 +186,19 @@ struct IPerlStdIOInfo #ifdef USE_STDIO_PTR # define PerlIO_has_cntptr(f) 1 -# ifdef STDIO_CNT_LVALUE -# define PerlIO_canset_cnt(f) 1 -# ifdef STDIO_PTR_LVALUE +# ifdef STDIO_PTR_LVALUE +# ifdef STDIO_CNT_LVALUE +# define PerlIO_canset_cnt(f) 1 +# ifdef STDIO_PTR_LVAL_NOCHANGE_CNT +# define PerlIO_fast_gets(f) 1 +# endif +# else /* STDIO_CNT_LVALUE */ +# define PerlIO_canset_cnt(f) 0 +# endif +# else /* STDIO_PTR_LVALUE */ +# ifdef STDIO_PTR_LVAL_SETS_CNT # define PerlIO_fast_gets(f) 1 # endif -# else -# define PerlIO_canset_cnt(f) 0 # endif #else /* USE_STDIO_PTR */ # define PerlIO_has_cntptr(f) 0 @@ -266,7 +272,7 @@ struct IPerlStdIOInfo #define PerlIO_setlinebuf(f) \ (*PL_StdIO->pSetlinebuf)(PL_StdIO, (f)) #define PerlIO_printf Perl_fprintf_nocontext -#define PerlIO_stdoutf *PL_StdIO->pPrintf +#define PerlIO_stdoutf Perl_printf_nocontext #define PerlIO_vprintf(f,fmt,a) \ (*PL_StdIO->pVprintf)(PL_StdIO, (f),(fmt),a) #define PerlIO_tell(f) \ @@ -466,11 +472,19 @@ extern PerlIO * PerlIO_stdout (void); extern PerlIO * PerlIO_stderr (void); #endif #ifndef PerlIO_getpos +#ifdef USE_SFIO +extern int PerlIO_getpos (PerlIO *,Off_t *); +#else extern int PerlIO_getpos (PerlIO *,Fpos_t *); #endif +#endif #ifndef PerlIO_setpos +#ifdef USE_SFIO +extern int PerlIO_setpos (PerlIO *,const Off_t *); +#else extern int PerlIO_setpos (PerlIO *,const Fpos_t *); #endif +#endif #ifndef PerlIO_fdupopen extern PerlIO * PerlIO_fdupopen (PerlIO *); #endif @@ -551,7 +565,7 @@ struct IPerlDirInfo #define PerlDir_mkdir(name, mode) Mkdir((name), (mode)) #ifdef VMS -# define PerlDir_chdir(n) chdir(((n) && *(n)) ? (n) : "SYS$LOGIN") +# define PerlDir_chdir(n) Chdir(((n) && *(n)) ? (n) : "SYS$LOGIN") #else # define PerlDir_chdir(name) chdir((name)) #endif diff --git a/contrib/perl5/lib/AutoLoader.pm b/contrib/perl5/lib/AutoLoader.pm index 8fd7d3b8fe2a..ad6bc4013b77 100644 --- a/contrib/perl5/lib/AutoLoader.pm +++ b/contrib/perl5/lib/AutoLoader.pm @@ -4,15 +4,19 @@ use 5.005_64; our(@EXPORT, @EXPORT_OK, $VERSION); my $is_dosish; +my $is_epoc; my $is_vms; +my $is_macos; BEGIN { require Exporter; @EXPORT = @EXPORT = (); @EXPORT_OK = @EXPORT_OK = qw(AUTOLOAD); $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32'; + $is_epoc = $^O eq 'epoc'; $is_vms = $^O eq 'VMS'; - $VERSION = '5.57'; + $is_macos = $^O eq 'MacOS'; + $VERSION = '5.58'; } AUTOLOAD { @@ -36,7 +40,12 @@ AUTOLOAD { my ($pkg,$func) = ($sub =~ /(.*)::([^:]+)$/); $pkg =~ s#::#/#g; if (defined($filename = $INC{"$pkg.pm"})) { - $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s; + if ($is_macos) { + $pkg =~ tr#/#:#; + $filename =~ s#^(.*)$pkg\.pm\z#$1auto:$pkg:$func.al#s; + } else { + $filename =~ s#^(.*)$pkg\.pm\z#$1auto/$pkg/$func.al#s; + } # if the file exists, then make sure that it is a # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al', @@ -51,11 +60,15 @@ AUTOLOAD { $filename = "./$filename"; } } - elsif ($is_vms) { + elsif ($is_epoc) { + unless ($filename =~ m{^([a-z?]:)?[\\/]}is) { + $filename = "./$filename"; + } + }elsif ($is_vms) { # XXX todo by VMSmiths $filename = "./$filename"; } - else { + elsif (!$is_macos) { $filename = "./$filename"; } } @@ -140,6 +153,11 @@ sub import { } } +sub unimport { + my $callpkg = caller; + eval "package $callpkg; sub AUTOLOAD;"; +} + 1; __END__ @@ -259,6 +277,12 @@ the package namespace. Variables pre-declared with this pragma will be visible to any autoloaded routines (but will not be invisible outside the package, unfortunately). +=head2 Not Using AutoLoader + +You can stop using AutoLoader by simply + + no AutoLoader; + =head2 B vs. B The B is similar in purpose to B: both delay the diff --git a/contrib/perl5/lib/AutoSplit.pm b/contrib/perl5/lib/AutoSplit.pm index 0be3ae6765a1..8fcf528101f9 100644 --- a/contrib/perl5/lib/AutoSplit.pm +++ b/contrib/perl5/lib/AutoSplit.pm @@ -6,6 +6,7 @@ use Config qw(%Config); use Carp qw(carp); use File::Basename (); use File::Path qw(mkpath); +use File::Spec::Functions qw(curdir catfile); use strict; our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Verbose, $Keep, $Maxlen, $CheckForAutoloader, $CheckModTime); @@ -173,16 +174,23 @@ sub autosplit_lib_modules{ my(@modules) = @_; # list of Module names while(defined($_ = shift @modules)){ - s#::#/#g; # incase specified as ABC::XYZ + while (m#(.*?[^:])::([^:].*)#) { # in case specified as ABC::XYZ + $_ = catfile($1, $2); + } s|\\|/|g; # bug in ksh OS/2 s#^lib/##s; # incase specified as lib/*.pm + my($lib) = catfile(curdir(), "lib"); + if ($Is_VMS) { # may need to convert VMS-style filespecs + $lib =~ s#^\[\]#.\/#; + } + s#^$lib\W+##s; # incase specified as ./lib/*.pm if ($Is_VMS && /[:>\]]/) { # may need to convert VMS-style filespecs my ($dir,$name) = (/(.*])(.*)/s); $dir =~ s/.*lib[\.\]]//s; $dir =~ s#[\.\]]#/#g; $_ = $dir . $name; } - autosplit_file("lib/$_", "lib/auto", + autosplit_file(catfile($lib, $_), catfile($lib, "auto"), $Keep, $CheckForAutoloader, $CheckModTime); } 0; @@ -199,7 +207,7 @@ sub autosplit_file { local($/) = "\n"; # where to write output files - $autodir ||= "lib/auto"; + $autodir ||= catfile(curdir(), "lib", "auto"); if ($Is_VMS) { ($autodir = VMS::Filespec::unixpath($autodir)) =~ s|/\z||; $filename = VMS::Filespec::unixify($filename); # may have dirs @@ -245,6 +253,9 @@ sub autosplit_file { $def_package or die "Can't find 'package Name;' in $filename\n"; my($modpname) = _modpname($def_package); + if ($Is_VMS) { + $modpname = VMS::Filespec::unixify($modpname); # may have dirs + } # this _has_ to match so we have a reasonable timestamp file die "Package $def_package ($modpname.pm) does not ". @@ -253,7 +264,7 @@ sub autosplit_file { ($^O eq 'dos') or ($^O eq 'MSWin32') or $Is_VMS && $filename =~ m/$modpname.pm/i); - my($al_idx_file) = "$autodir/$modpname/$IndexFile"; + my($al_idx_file) = catfile($autodir, $modpname, $IndexFile); if ($check_mod_time){ my($al_ts_time) = (stat("$al_idx_file"))[9] || 1; @@ -264,11 +275,12 @@ sub autosplit_file { } } - print "AutoSplitting $filename ($autodir/$modpname)\n" + my($modnamedir) = catfile($autodir, $modpname); + print "AutoSplitting $filename ($modnamedir)\n" if $Verbose; - unless (-d "$autodir/$modpname"){ - mkpath("$autodir/$modpname",0,0777); + unless (-d $modnamedir){ + mkpath($modnamedir,0,0777); } # We must try to deal with some SVR3 systems with a limit of 14 @@ -311,9 +323,10 @@ sub autosplit_file { push(@subnames, $fq_subname); my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3)); $modpname = _modpname($this_package); - mkpath("$autodir/$modpname",0,0777); - my($lpath) = "$autodir/$modpname/$lname.al"; - my($spath) = "$autodir/$modpname/$sname.al"; + my($modnamedir) = catfile($autodir, $modpname); + mkpath($modnamedir,0,0777); + my($lpath) = catfile($modnamedir, "$lname.al"); + my($spath) = catfile($modnamedir, "$sname.al"); my $path; if (!$Is83 and open(OUT, ">$lpath")){ $path=$lpath; @@ -379,7 +392,7 @@ EOT opendir(OUTDIR,$dir); foreach (sort readdir(OUTDIR)){ next unless /\.al\z/; - my($file) = "$dir/$_"; + my($file) = catfile($dir, $_); $file = lc $file if $Is83 or $Is_VMS; next if $outfiles{$file}; print " deleting $file\n" if ($Verbose>=2); @@ -418,7 +431,9 @@ sub _modpname ($) { if ($^O eq 'MSWin32') { $modpname =~ s#::#\\#g; } else { - $modpname =~ s#::#/#g; + while ($modpname =~ m#(.*?[^:])::([^:].*)#) { + $modpname = catfile($1, $2); + } } $modpname; } diff --git a/contrib/perl5/lib/Benchmark.pm b/contrib/perl5/lib/Benchmark.pm index 3c10a5bc523b..b557be3cc7a6 100644 --- a/contrib/perl5/lib/Benchmark.pm +++ b/contrib/perl5/lib/Benchmark.pm @@ -552,7 +552,9 @@ sub countit { # accuracy since we're not couting these times. $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation. my $td = timeit($n, $code); - $tc = $td->[1] + $td->[2]; + my $new_tc = $td->[1] + $td->[2]; + # Make sure we are making progress. + $tc = $new_tc > 1.2 * $tc ? $new_tc : 1.2 * $tc; } # Now, do the 'for real' timing(s), repeating until we exceed @@ -581,6 +583,7 @@ sub countit { $ttot = $utot + $stot; last if $ttot >= $tmax; + $ttot = 0.01 if $ttot < 0.01; my $r = $tmax / $ttot - 1; # Linear approximation. $n = int( $r * $ntot ); $n = $nmin if $n < $nmin; diff --git a/contrib/perl5/lib/CPAN.pm b/contrib/perl5/lib/CPAN.pm index 84dfd31a2b8c..fdaadb3be7ac 100644 --- a/contrib/perl5/lib/CPAN.pm +++ b/contrib/perl5/lib/CPAN.pm @@ -1,18 +1,11 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- package CPAN; -use vars qw{$Try_autoload - $Revision - $META $Signal $Cwd $End - $Suppress_readline %Dontload - $Frontend $Defaultsite - }; #}; - -$VERSION = '1.52'; - -# $Id: CPAN.pm,v 1.276 2000/01/08 15:29:46 k Exp $ +$VERSION = '1.59_54'; +# $Id: CPAN.pm,v 1.385 2001/02/09 21:37:57 k Exp $ # only used during development: $Revision = ""; -# $Revision = "[".substr(q$Revision: 1.276 $, 10)."]"; +# $Revision = "[".substr(q$Revision: 1.385 $, 10)."]"; use Carp (); use Config (); @@ -29,6 +22,8 @@ use Safe (); use Text::ParseWords (); use Text::Wrap; use File::Spec; +no lib "."; # we need to run chdir all over and we would get at wrong + # libraries there END { $End++; &cleanup; } @@ -47,6 +42,8 @@ END { $End++; &cleanup; } Eval 2048 Config 4096 Tarzip 8192 + Version 16384 + Queue 32768 ]; $CPAN::DEBUG ||= 0; @@ -55,9 +52,12 @@ $CPAN::Frontend ||= "CPAN::Shell"; $CPAN::Defaultsite ||= "ftp://ftp.perl.org/pub/CPAN"; package CPAN; -use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term); use strict qw(vars); +use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $HAS_USABLE $term + $Revision $Signal $End $Suppress_readline $Frontend + $Defaultsite $Have_warned); + @CPAN::ISA = qw(CPAN::Debug Exporter); @EXPORT = qw( @@ -75,12 +75,6 @@ sub AUTOLOAD { if (exists $EXPORT{$l}){ CPAN::Shell->$l(@_); } else { - my $ok = CPAN::Shell->try_dot_al($AUTOLOAD); - if ($ok) { - goto &$AUTOLOAD; -# } else { -# $CPAN::Frontend->mywarn("Could not autoload $AUTOLOAD"); - } $CPAN::Frontend->mywarn(qq{Unknown command "$AUTOLOAD". }. qq{Type ? for help. }); @@ -93,22 +87,24 @@ sub shell { $Suppress_readline = ! -t STDIN unless defined $Suppress_readline; CPAN::Config->load unless $CPAN::Config_loaded++; - my $prompt = "cpan> "; + my $oprompt = shift || "cpan> "; + my $prompt = $oprompt; + my $commandline = shift || ""; + local($^W) = 1; unless ($Suppress_readline) { require Term::ReadLine; -# import Term::ReadLine; - $term = Term::ReadLine->new('CPAN Monitor'); + if (! $term + or + $term->ReadLine eq "Term::ReadLine::Stub" + ) { + $term = Term::ReadLine->new('CPAN Monitor'); + } if ($term->ReadLine eq "Term::ReadLine::Gnu") { my $attribs = $term->Attribs; -# $attribs->{completion_entry_function} = -# $attribs->{'list_completion_function'}; $attribs->{attempted_completion_function} = sub { &CPAN::Complete::gnu_cpl; } -# $attribs->{completion_word} = -# [qw(help me somebody to find out how -# to use completion with GNU)]; } else { $readline::rl_completion_function = $readline::rl_completion_function = 'CPAN::Complete::cpl'; @@ -121,38 +117,42 @@ sub shell { select $odef; } - no strict; + # no strict; # I do not recall why no strict was here (2000-09-03) $META->checklock(); - my $getcwd; - $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; - my $cwd = CPAN->$getcwd(); + my $cwd = CPAN::anycwd(); my $try_detect_readline; $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub" if $term; my $rl_avail = $Suppress_readline ? "suppressed" : ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" : - "available (try ``install Bundle::CPAN'')"; + "available (try 'install Bundle::CPAN')"; $CPAN::Frontend->myprint( - qq{ -cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION$CPAN::Revision) -ReadLine support $rl_avail + sprintf qq{ +cpan shell -- CPAN exploration and modules installation (v%s%s) +ReadLine support %s -}) unless $CPAN::Config->{'inhibit_startup_message'} ; +}, + $CPAN::VERSION, + $CPAN::Revision, + $rl_avail + ) + unless $CPAN::Config->{'inhibit_startup_message'} ; my($continuation) = ""; - while () { + SHELLCOMMAND: while () { if ($Suppress_readline) { print $prompt; - last unless defined ($_ = <> ); + last SHELLCOMMAND unless defined ($_ = <> ); chomp; } else { - last unless defined ($_ = $term->readline($prompt)); + last SHELLCOMMAND unless + defined ($_ = $term->readline($prompt, $commandline)); } $_ = "$continuation$_" if $continuation; s/^\s+//; - next if /^$/; + next SHELLCOMMAND if /^$/; $_ = 'h' if /^\s*\?/; if (/^(?:q(?:uit)?|bye|exit)$/i) { - last; + last SHELLCOMMAND; } elsif (s/\\$//s) { chomp; $continuation = $_; @@ -167,25 +167,30 @@ ReadLine support $rl_avail eval($eval); warn $@ if $@; $continuation = ""; - $prompt = "cpan> "; + $prompt = $oprompt; } elsif (/./) { my(@line); if ($] < 5.00322) { # parsewords had a bug until recently @line = split; } else { eval { @line = Text::ParseWords::shellwords($_) }; - warn($@), next if $@; + warn($@), next SHELLCOMMAND if $@; + warn("Text::Parsewords could not parse the line [$_]"), + next SHELLCOMMAND unless @line; } $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG; my $command = shift @line; eval { CPAN::Shell->$command(@line) }; warn $@ if $@; - chdir $cwd; + chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!}); $CPAN::Frontend->myprint("\n"); $continuation = ""; - $prompt = "cpan> "; + $prompt = $oprompt; } } continue { + $commandline = ""; # I do want to be able to pass a default to + # shell, but on the second command I see no + # use in that $Signal=0; CPAN::Queue->nullify_queue; if ($try_detect_readline) { @@ -194,15 +199,17 @@ ReadLine support $rl_avail $CPAN::META->has_inst("Term::ReadLine::Perl") ) { delete $INC{"Term/ReadLine.pm"}; - my $redef; - local($SIG{__WARN__}) = CPAN::Shell::dotdot_onreload(\$redef); + my $redef = 0; + local($SIG{__WARN__}) = CPAN::Shell::paintdots_onreload(\$redef); require Term::ReadLine; $CPAN::Frontend->myprint("\n$redef subroutines in ". "Term::ReadLine redefined\n"); + @_ = ($oprompt,""); goto &shell; } } } + chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!}); } package CPAN::CacheMgr; @@ -210,7 +217,6 @@ package CPAN::CacheMgr; use File::Find; package CPAN::Config; -import ExtUtils::MakeMaker 'neatvalue'; use vars qw(%can $dot_cpan); %can = ( @@ -223,14 +229,25 @@ package CPAN::FTP; use vars qw($Ua $Thesite $Themethod); @CPAN::FTP::ISA = qw(CPAN::Debug); +package CPAN::LWP::UserAgent; +use vars qw(@ISA $USER $PASSWD $SETUPDONE); +# we delay requiring LWP::UserAgent and setting up inheritence until we need it + package CPAN::Complete; @CPAN::Complete::ISA = qw(CPAN::Debug); +@CPAN::Complete::COMMANDS = sort qw( + ! a b d h i m o q r u autobundle clean dump + make test install force readme reload look + cvs_import ls +) unless @CPAN::Complete::COMMANDS; package CPAN::Index; -use vars qw($last_time $date_of_03); +use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03); @CPAN::Index::ISA = qw(CPAN::Debug); -$last_time ||= 0; -$date_of_03 ||= 0; +$LAST_TIME ||= 0; +$DATE_OF_03 ||= 0; +# use constant PROTOCOL => "2.0"; # outcommented to avoid warning on upgrade from 1.57 +sub PROTOCOL { 2.0 } package CPAN::InfoObj; @CPAN::InfoObj::ISA = qw(CPAN::Debug); @@ -248,8 +265,10 @@ package CPAN::Module; @CPAN::Module::ISA = qw(CPAN::InfoObj); package CPAN::Shell; -use vars qw($AUTOLOAD $redef @ISA); +use vars qw($AUTOLOAD @ISA $COLOR_REGISTERED $ADVANCED_QUERY $PRINT_ORNAMENTING); @CPAN::Shell::ISA = qw(CPAN::Debug); +$COLOR_REGISTERED ||= 0; +$PRINT_ORNAMENTING ||= 0; #-> sub CPAN::Shell::AUTOLOAD ; sub AUTOLOAD { @@ -269,89 +288,16 @@ For this you just need to type }); } } else { - my $ok = CPAN::Shell->try_dot_al($AUTOLOAD); - if ($ok) { - goto &$AUTOLOAD; -# } else { -# $CPAN::Frontend->mywarn("Could not autoload $autoload"); - } $CPAN::Frontend->mywarn(qq{Unknown command '$autoload'. }. qq{Type ? for help. }); } } -#-> CPAN::Shell::try_dot_al -sub try_dot_al { - my($class,$autoload) = @_; - return unless $CPAN::Try_autoload; - # I don't see how to re-use that from the AutoLoader... - my($name,$ok); - # Braces used to preserve $1 et al. - { - my ($pkg,$func) = $autoload =~ /(.*)::([^:]+)$/; - $pkg =~ s|::|/|g; - if (defined($name=$INC{"$pkg.pm"})) - { - $name =~ s|^(.*)$pkg\.pm\z|$1auto/$pkg/$func.al|s; - $name = undef unless (-r $name); - } - unless (defined $name) - { - $name = "auto/$autoload.al"; - $name =~ s|::|/|g; - } - } - my $save = $@; - eval {local $SIG{__DIE__};require $name}; - if ($@) { - if (substr($autoload,-9) eq '::DESTROY') { - *$autoload = sub {}; - $ok = 1; - } else { - if ($name =~ s{(\w{12,})\.al\z}{substr($1,0,11).".al"}e){ - eval {local $SIG{__DIE__};require $name}; - } - if ($@){ - $@ =~ s/ at .*\n//; - Carp::croak $@; - } else { - $ok = 1; - } - } - } else { - - $ok = 1; - - } - $@ = $save; -# my $lm = Carp::longmess(); -# warn "ok[$ok] autoload[$autoload] longmess[$lm]"; # debug - return $ok; -} - -#### autoloader is experimental -#### to try it we have to set $Try_autoload and uncomment -#### the use statement and uncomment the __END__ below -#### You also need AutoSplit 1.01 available. MakeMaker will -#### then build CPAN with all the AutoLoad stuff. -# use AutoLoader; -# $Try_autoload = 1; - -if ($CPAN::Try_autoload) { - my $p; - for $p (qw( - CPAN::Author CPAN::Bundle CPAN::CacheMgr CPAN::Complete - CPAN::Config CPAN::Debug CPAN::Distribution CPAN::FTP - CPAN::FTP::netrc CPAN::Index CPAN::InfoObj CPAN::Module - )) { - *{"$p\::AUTOLOAD"} = \&AutoLoader::AUTOLOAD; - } -} - package CPAN::Tarzip; -use vars qw($AUTOLOAD @ISA); +use vars qw($AUTOLOAD @ISA $BUGHUNTING); @CPAN::Tarzip::ISA = qw(CPAN::Debug); +$BUGHUNTING = 0; # released code must have turned off package CPAN::Queue; @@ -402,70 +348,81 @@ package CPAN::Queue; use vars qw{ @All }; +# CPAN::Queue::new ; sub new { - my($class,$mod) = @_; - my $self = bless {mod => $mod}, $class; + my($class,$s) = @_; + my $self = bless { qmod => $s }, $class; push @All, $self; - # my @all = map { $_->{mod} } @All; - # warn "Adding Queue object for mod[$mod] all[@all]"; return $self; } +# CPAN::Queue::first ; sub first { my $obj = $All[0]; - $obj->{mod}; + $obj->{qmod}; } +# CPAN::Queue::delete_first ; sub delete_first { my($class,$what) = @_; my $i; for my $i (0..$#All) { - if ( $All[$i]->{mod} eq $what ) { + if ( $All[$i]->{qmod} eq $what ) { splice @All, $i, 1; return; } } } +# CPAN::Queue::jumpqueue ; sub jumpqueue { - my $class = shift; - my @what = @_; - my $obj; + my $class = shift; + my @what = @_; + CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]", + join(",",map {$_->{qmod}} @All), + join(",",@what) + )) if $CPAN::DEBUG; WHAT: for my $what (reverse @what) { - my $jumped = 0; - for (my $i=0; $i<$#All;$i++) { #prevent deep recursion - if ($All[$i]->{mod} eq $what){ - $jumped++; - if ($jumped > 100) { # one's OK if e.g. just processing now; - # more are OK if user typed it several - # times - $CPAN::Frontend->mywarn( + my $jumped = 0; + for (my $i=0; $i<$#All;$i++) { #prevent deep recursion + CPAN->debug("i[$All[$i]]what[$what]") if $CPAN::DEBUG; + if ($All[$i]->{qmod} eq $what){ + $jumped++; + if ($jumped > 100) { # one's OK if e.g. just + # processing now; more are OK if + # user typed it several times + $CPAN::Frontend->mywarn( qq{Object [$what] queued more than 100 times, ignoring} ); - next WHAT; - } - } + next WHAT; + } + } + } + my $obj = bless { qmod => $what }, $class; + unshift @All, $obj; } - my $obj = bless { mod => $what }, $class; - unshift @All, $obj; - } + CPAN->debug(sprintf("after jumpqueue All[%s] what[%s]", + join(",",map {$_->{qmod}} @All), + join(",",@what) + )) if $CPAN::DEBUG; } +# CPAN::Queue::exists ; sub exists { my($self,$what) = @_; - my @all = map { $_->{mod} } @All; - my $exists = grep { $_->{mod} eq $what } @All; - # warn "Checking exists in Queue object for mod[$what] all[@all] exists[$exists]"; + my @all = map { $_->{qmod} } @All; + my $exists = grep { $_->{qmod} eq $what } @All; + # warn "in exists what[$what] all[@all] exists[$exists]"; $exists; } +# CPAN::Queue::delete ; sub delete { my($self,$mod) = @_; - @All = grep { $_->{mod} ne $mod } @All; - # my @all = map { $_->{mod} } @All; - # warn "Deleting Queue object for mod[$mod] all[@all]"; + @All = grep { $_->{qmod} ne $mod } @All; } +# CPAN::Queue::nullify_queue ; sub nullify_queue { @All = (); } @@ -476,44 +433,31 @@ package CPAN; $META ||= CPAN->new; # In case we re-eval ourselves we need the || -1; +# from here on only subs. +################################################################################ -# __END__ # uncomment this and AutoSplit version 1.01 will split it - -#-> sub CPAN::autobundle ; -sub autobundle; -#-> sub CPAN::bundle ; -sub bundle; -#-> sub CPAN::expand ; -sub expand; -#-> sub CPAN::force ; -sub force; -#-> sub CPAN::install ; -sub install; -#-> sub CPAN::make ; -sub make; -#-> sub CPAN::clean ; -sub clean; -#-> sub CPAN::test ; -sub test; - -#-> sub CPAN::all ; +#-> sub CPAN::all_objects ; sub all_objects { my($mgr,$class) = @_; CPAN::Config->load unless $CPAN::Config_loaded++; CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG; CPAN::Index->reload; - values %{ $META->{$class} }; + values %{ $META->{readwrite}{$class} }; # unsafe meta access, ok } *all = \&all_objects; -# Called by shell, not in batch mode. Not clean XXX +# Called by shell, not in batch mode. In batch mode I see no risk in +# having many processes updating something as installations are +# continually checked at runtime. In shell mode I suspect it is +# unintentional to open more than one shell at a time + #-> sub CPAN::checklock ; sub checklock { my($self) = @_; my $lockfile = MM->catfile($CPAN::Config->{cpan_home},".lock"); if (-f $lockfile && -M _ > 0) { - my $fh = FileHandle->new($lockfile); + my $fh = FileHandle->new($lockfile) or + $CPAN::Frontend->mydie("Could not open $lockfile: $!"); my $other = <$fh>; $fh->close; if (defined $other && $other) { @@ -545,7 +489,11 @@ You may want to kill it and delete the lockfile, maybe. On UNIX try: qq{ and then rerun us.\n} ); } - } + } else { + $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile $lockfile ". + "reports other process with ID ". + "$other. Cannot proceed.\n")); + } } my $dotcpan = $CPAN::Config->{cpan_home}; eval { File::Path::mkpath($dotcpan);}; @@ -610,11 +558,11 @@ or $fh->print($$, "\n"); $self->{LOCK} = $lockfile; $fh->close; - $SIG{'TERM'} = sub { + $SIG{TERM} = sub { &cleanup; $CPAN::Frontend->mydie("Got SIGTERM, leaving"); }; - $SIG{'INT'} = sub { + $SIG{INT} = sub { # no blocks!!! &cleanup if $Signal; $CPAN::Frontend->mydie("Got another SIGINT") if $Signal; @@ -642,7 +590,8 @@ or # # Larry - $SIG{'__DIE__'} = \&cleanup; + # global backstop to cleanup if we should really die + $SIG{__DIE__} = \&cleanup; $self->debug("Signal handler set.") if $CPAN::DEBUG; } @@ -651,6 +600,13 @@ sub DESTROY { &cleanup; # need an eval? } +#-> sub CPAN::anycwd ; +sub anycwd () { + my $getcwd; + $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; + CPAN->$getcwd(); +} + #-> sub CPAN::cwd ; sub cwd {Cwd::cwd();} @@ -660,16 +616,55 @@ sub getcwd {Cwd::getcwd();} #-> sub CPAN::exists ; sub exists { my($mgr,$class,$id) = @_; + CPAN::Config->load unless $CPAN::Config_loaded++; CPAN::Index->reload; ### Carp::croak "exists called without class argument" unless $class; $id ||= ""; - exists $META->{$class}{$id}; + exists $META->{readonly}{$class}{$id} or + exists $META->{readwrite}{$class}{$id}; # unsafe meta access, ok } #-> sub CPAN::delete ; sub delete { my($mgr,$class,$id) = @_; - delete $META->{$class}{$id}; + delete $META->{readonly}{$class}{$id}; # unsafe meta access, ok + delete $META->{readwrite}{$class}{$id}; # unsafe meta access, ok +} + +#-> sub CPAN::has_usable +# has_inst is sometimes too optimistic, we should replace it with this +# has_usable whenever a case is given +sub has_usable { + my($self,$mod,$message) = @_; + return 1 if $HAS_USABLE->{$mod}; + my $has_inst = $self->has_inst($mod,$message); + return unless $has_inst; + my $usable; + $usable = { + LWP => [ # we frequently had "Can't locate object + # method "new" via package "LWP::UserAgent" at + # (eval 69) line 2006 + sub {require LWP}, + sub {require LWP::UserAgent}, + sub {require HTTP::Request}, + sub {require URI::URL}, + ], + Net::FTP => [ + sub {require Net::FTP}, + sub {require Net::Config}, + ] + }; + if ($usable->{$mod}) { + for my $c (0..$#{$usable->{$mod}}) { + my $code = $usable->{$mod}[$c]; + my $ret = eval { &$code() }; + if ($@) { + warn "DEBUG: c[$c]\$\@[$@]ret[$ret]"; + return; + } + } + } + return $HAS_USABLE->{$mod} = 1; } #-> sub CPAN::has_inst @@ -677,11 +672,14 @@ sub has_inst { my($self,$mod,$message) = @_; Carp::croak("CPAN->has_inst() called without an argument") unless defined $mod; - if (defined $message && $message eq "no") { - $Dontload{$mod}||=1; - return 0; - } elsif (exists $Dontload{$mod}) { - return 0; + if (defined $message && $message eq "no" + || + exists $CPAN::META->{dontload_hash}{$mod} # unsafe meta access, ok + || + exists $CPAN::Config->{dontload_hash}{$mod} + ) { + $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok + return 0; } my $file = $mod; my $obj; @@ -707,13 +705,13 @@ sub has_inst { } return 1; } elsif ($mod eq "Net::FTP") { - warn qq{ + $CPAN::Frontend->mywarn(qq{ Please, install Net::FTP as soon as possible. CPAN.pm installs it for you if you just type install Bundle::libnet -}; - sleep 2; +}) unless $Have_warned->{"Net::FTP"}++; + sleep 3; } elsif ($mod eq "MD5"){ $CPAN::Frontend->myprint(qq{ CPAN: MD5 security checks disabled because MD5 not installed. @@ -732,7 +730,9 @@ sub instance { my($mgr,$class,$id) = @_; CPAN::Index->reload; $id ||= ""; - $META->{$class}{$id} ||= $class->new(ID => $id ); + # unsafe meta access, ok? + return $META->{readwrite}{$class}{$id} if exists $META->{readwrite}{$class}{$id}; + $META->{readwrite}{$class}{$id} ||= $class->new(ID => $id); } #-> sub CPAN::new ; @@ -760,9 +760,9 @@ sub cleanup { } } return if $ineval && !$End; - return unless defined $META->{'LOCK'}; - return unless -f $META->{'LOCK'}; - unlink $META->{'LOCK'}; + return unless defined $META->{LOCK}; # unsafe meta access, ok + return unless -f $META->{LOCK}; # unsafe meta access, ok + unlink $META->{LOCK}; # unsafe meta access, ok # require Carp; # Carp::cluck("DEBUGGING"); $CPAN::Frontend->mywarn("Lockfile removed.\n"); @@ -785,6 +785,7 @@ sub cachesize { shift->{DU}; } +#-> sub CPAN::CacheMgr::tidyup ; sub tidyup { my($self) = @_; return unless -d $self->{ID}; @@ -812,9 +813,7 @@ sub entries { return unless defined $dir; $self->debug("reading dir[$dir]") if $CPAN::DEBUG; $dir ||= $self->{ID}; - my $getcwd; - $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; - my($cwd) = CPAN->$getcwd(); + my($cwd) = CPAN::anycwd(); chdir $dir or Carp::croak("Can't chdir to $dir: $!"); my $dh = DirHandle->new(File::Spec->curdir) or Carp::croak("Couldn't opendir $dir: $!"); @@ -942,49 +941,85 @@ sub debug { package CPAN::Config; #-> sub CPAN::Config::edit ; +# returns true on successful action sub edit { - my($class,@args) = @_; + my($self,@args) = @_; return unless @args; - CPAN->debug("class[$class]args[".join(" | ",@args)."]"); + CPAN->debug("self[$self]args[".join(" | ",@args)."]"); my($o,$str,$func,$args,$key_exists); $o = shift @args; if($can{$o}) { - $class->$o(@args); + $self->$o(@args); return 1; } else { - if (ref($CPAN::Config->{$o}) eq ARRAY) { + CPAN->debug("o[$o]") if $CPAN::DEBUG; + if ($o =~ /list$/) { $func = shift @args; $func ||= ""; + CPAN->debug("func[$func]") if $CPAN::DEBUG; + my $changed; # Let's avoid eval, it's easier to comprehend without. if ($func eq "push") { push @{$CPAN::Config->{$o}}, @args; + $changed = 1; } elsif ($func eq "pop") { pop @{$CPAN::Config->{$o}}; + $changed = 1; } elsif ($func eq "shift") { shift @{$CPAN::Config->{$o}}; + $changed = 1; } elsif ($func eq "unshift") { unshift @{$CPAN::Config->{$o}}, @args; + $changed = 1; } elsif ($func eq "splice") { splice @{$CPAN::Config->{$o}}, @args; + $changed = 1; } elsif (@args) { $CPAN::Config->{$o} = [@args]; + $changed = 1; } else { - $CPAN::Frontend->myprint( - join "", - " $o ", - ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}), - "\n" - ); + $self->prettyprint($o); } + if ($o eq "urllist" && $changed) { + # reset the cached values + undef $CPAN::FTP::Thesite; + undef $CPAN::FTP::Themethod; + } + return $changed; } else { $CPAN::Config->{$o} = $args[0] if defined $args[0]; - $CPAN::Frontend->myprint(" $o " . - (defined $CPAN::Config->{$o} ? - $CPAN::Config->{$o} : "UNDEFINED")); + $self->prettyprint($o); } } } +sub prettyprint { + my($self,$k) = @_; + my $v = $CPAN::Config->{$k}; + if (ref $v) { + my(@report) = ref $v eq "ARRAY" ? + @$v : + map { sprintf(" %-18s => %s\n", + $_, + defined $v->{$_} ? $v->{$_} : "UNDEFINED" + )} keys %$v; + $CPAN::Frontend->myprint( + join( + "", + sprintf( + " %-18s\n", + $k + ), + map {"\t$_\n"} @report + ) + ); + } elsif (defined $v) { + $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v); + } else { + $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, "UNDEFINED"); + } +} + #-> sub CPAN::Config::commit ; sub commit { my($self,$configpm) = @_; @@ -1005,7 +1040,8 @@ Please specify a filename where to save the configuration or try } } - my $msg = <new; rename $configpm, "$configpm~" if -f $configpm; - open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!"; + open $fh, ">$configpm" or + $CPAN::Frontend->mydie("Couldn't open >$configpm: $!"); $fh->print(qq[$msg\$CPAN::Config = \{\n]); foreach (sort keys %$CPAN::Config) { $fh->print( @@ -1069,8 +1106,8 @@ sub load { # system wide settings shift @INC; } - return unless @miss = $self->not_loaded; - # XXX better check for arrayrefs too + return unless @miss = $self->missing_config_data; + require CPAN::FirstTime; my($configpm,$fh,$redo,$theycalled); $redo ||= ""; @@ -1137,15 +1174,18 @@ $configpm initialized. CPAN::FirstTime::init($configpm); } -#-> sub CPAN::Config::not_loaded ; -sub not_loaded { +#-> sub CPAN::Config::missing_config_data ; +sub missing_config_data { my(@miss); - for (qw( - cpan_home keep_source_where build_dir build_cache scan_cache - index_expire gzip tar unzip make pager makepl_arg make_arg - make_install_arg urllist inhibit_startup_message - ftp_proxy http_proxy no_proxy prerequisites_policy - )) { + for ( + "cpan_home", "keep_source_where", "build_dir", "build_cache", + "scan_cache", "index_expire", "gzip", "tar", "unzip", "make", + "pager", + "makepl_arg", "make_arg", "make_install_arg", "urllist", + "inhibit_startup_message", "ftp_proxy", "http_proxy", "no_proxy", + "prerequisites_policy", + "cache_metadata", + ) { push @miss, $_ unless defined $CPAN::Config->{$_}; } return @miss; @@ -1213,19 +1253,17 @@ sub h { } else { $CPAN::Frontend->myprint(q{ Display Information - a authors - b string display bundles - d or info distributions - m /regex/ about modules - i or anything of above - r none reinstall recommendations - u uninstalled distributions + command argument description + a,b,d,m WORD or /REGEXP/ about authors, bundles, distributions, modules + i WORD or /REGEXP/ about anything of above + r NONE reinstall recommendations + ls AUTHOR about files in the author's directory Download, Test, Make, Install... get download make make (implies get) - test modules, make test (implies make) - install dists, bundles make install (implies test) + test MODULES, make test (implies make) + install DISTS, BUNDLES make install (implies test) clean make clean look open subshell in these dists' directories readme display these dists' README files @@ -1241,27 +1279,68 @@ Other *help = \&h; #-> sub CPAN::Shell::a ; -sub a { $CPAN::Frontend->myprint(shift->format_result('Author',@_));} +sub a { + my($self,@arg) = @_; + # authors are always UPPERCASE + for (@arg) { + $_ = uc $_ unless /=/; + } + $CPAN::Frontend->myprint($self->format_result('Author',@arg)); +} + +#-> sub CPAN::Shell::ls ; +sub ls { + my($self,@arg) = @_; + my @accept; + for (@arg) { + unless (/^[A-Z\-]+$/i) { + $CPAN::Frontend->mywarn("ls command rejects argument $_: not an author"); + next; + } + push @accept, uc $_; + } + for my $a (@accept){ + my $author = $self->expand('Author',$a) or die "No author found for $a"; + $author->ls; + } +} + +#-> sub CPAN::Shell::local_bundles ; +sub local_bundles { + my($self,@which) = @_; + my($incdir,$bdir,$dh); + foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) { + my @bbase = "Bundle"; + while (my $bbase = shift @bbase) { + $bdir = MM->catdir($incdir,split /::/, $bbase); + CPAN->debug("bdir[$bdir]\@bbase[@bbase]") if $CPAN::DEBUG; + if ($dh = DirHandle->new($bdir)) { # may fail + my($entry); + for $entry ($dh->read) { + next if $entry =~ /^\./; + if (-d MM->catdir($bdir,$entry)){ + push @bbase, "$bbase\::$entry"; + } else { + next unless $entry =~ s/\.pm(?!\n)\Z//; + $CPAN::META->instance('CPAN::Bundle',"$bbase\::$entry"); + } + } + } + } + } +} + #-> sub CPAN::Shell::b ; sub b { my($self,@which) = @_; CPAN->debug("which[@which]") if $CPAN::DEBUG; - my($incdir,$bdir,$dh); - foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) { - $bdir = MM->catdir($incdir,"Bundle"); - if ($dh = DirHandle->new($bdir)) { # may fail - my($entry); - for $entry ($dh->read) { - next if -d MM->catdir($bdir,$entry); - next unless $entry =~ s/\.pm\z//; - $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry"); - } - } - } + $self->local_bundles; $CPAN::Frontend->myprint($self->format_result('Bundle',@which)); } + #-> sub CPAN::Shell::d ; sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));} + #-> sub CPAN::Shell::m ; sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here $CPAN::Frontend->myprint(shift->format_result('Module',@_)); @@ -1278,21 +1357,28 @@ sub i { for $type (@type) { push @result, $self->expand($type,@args); } - my $result = @result == 1 ? + my $result = @result == 1 ? $result[0]->as_string : - join "", map {$_->as_glimpse} @result; - $result ||= "No objects found of any type for argument @args\n"; + @result == 0 ? + "No objects found of any type for argument @args\n" : + join("", + (map {$_->as_glimpse} @result), + scalar @result, " items found\n", + ); $CPAN::Frontend->myprint($result); } #-> sub CPAN::Shell::o ; + +# CPAN::Shell::o and CPAN::Config::edit are closely related. 'o conf' +# should have been called set and 'o debug' maybe 'set debug' sub o { my($self,$o_type,@o_what) = @_; $o_type ||= ""; CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n"); if ($o_type eq 'conf') { shift @o_what if @o_what && $o_what[0] eq 'help'; - if (!@o_what) { + if (!@o_what) { # print all things, "o conf" my($k,$v); $CPAN::Frontend->myprint("CPAN::Config options"); if (exists $INC{'CPAN/Config.pm'}) { @@ -1308,25 +1394,12 @@ sub o { } $CPAN::Frontend->myprint("\n"); for $k (sort keys %$CPAN::Config) { - $v = $CPAN::Config->{$k}; - if (ref $v) { - $CPAN::Frontend->myprint( - join( - "", - sprintf( - " %-18s\n", - $k - ), - map {"\t$_\n"} @{$v} - ) - ); - } else { - $CPAN::Frontend->myprint(sprintf " %-18s %s\n", $k, $v); - } + CPAN::Config->prettyprint($k); } $CPAN::Frontend->myprint("\n"); } elsif (!CPAN::Config->edit(@o_what)) { - $CPAN::Frontend->myprint(qq[Type 'o conf' to view configuration edit options\n\n]); + $CPAN::Frontend->myprint(qq{Type 'o conf' to view configuration }. + qq{edit options\n\n}); } } elsif ($o_type eq 'debug') { my(%valid); @@ -1334,6 +1407,10 @@ sub o { if (@o_what) { while (@o_what) { my($what) = shift @o_what; + if ($what =~ s/^-// && exists $CPAN::DEBUG{$what}) { + $CPAN::DEBUG &= $CPAN::DEBUG ^ $CPAN::DEBUG{$what}; + next; + } if ( exists $CPAN::DEBUG{$what} ) { $CPAN::DEBUG |= $CPAN::DEBUG{$what}; } elsif ($what =~ /^\d/) { @@ -1369,7 +1446,8 @@ sub o { my($k,$v); for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) { $v = $CPAN::DEBUG{$k}; - $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v) if $v & $CPAN::DEBUG; + $CPAN::Frontend->myprint(sprintf " %-14s(%s)\n", $k, $v) + if $v & $CPAN::DEBUG; } } else { $CPAN::Frontend->myprint("Debugging turned off completely.\n"); @@ -1383,10 +1461,10 @@ Known options: } } -sub dotdot_onreload { +sub paintdots_onreload { my($ref) = shift; sub { - if ( $_[0] =~ /Subroutine (\w+) redefined/ ) { + if ( $_[0] =~ /[Ss]ubroutine (\w+) redefined/ ) { my($subr) = $1; ++$$ref; local($|) = 1; @@ -1407,8 +1485,8 @@ sub reload { CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG; my $fh = FileHandle->new($INC{'CPAN.pm'}); local($/); - $redef = 0; - local($SIG{__WARN__}) = dotdot_onreload(\$redef); + my $redef = 0; + local($SIG{__WARN__}) = paintdots_onreload(\$redef); eval <$fh>; warn $@ if $@; $CPAN::Frontend->myprint("\n$redef subroutines redefined\n"); @@ -1424,12 +1502,12 @@ index re-reads the index files\n}); sub _binary_extensions { my($self) = shift @_; my(@result,$module,%seen,%need,$headerdone); - my $isaperl = q{perl5[._-]\\d{3}(_[0-4][0-9])?\\.tar[._-]gz\z}; for $module ($self->expand('Module','/./')) { my $file = $module->cpan_file; next if $file eq "N/A"; next if $file =~ /^Contact Author/; - next if $file =~ / $isaperl /xo; + my $dist = $CPAN::META->instance('CPAN::Distribution',$file); + next if $dist->isa_perl; next unless $module->xs_file; local($|) = 1; $CPAN::Frontend->myprint("."); @@ -1467,15 +1545,21 @@ sub _u_r_common { my($self) = shift @_; my($what) = shift @_; CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG; - Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what; - Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/; + Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless + $what && $what =~ /^[aru]$/; my(@args) = @_; @args = '/./' unless @args; my(@result,$module,%seen,%need,$headerdone, $version_undefs,$version_zeroes); $version_undefs = $version_zeroes = 0; - my $sprintf = "%-25s %9s %9s %s\n"; - for $module ($self->expand('Module',@args)) { + my $sprintf = "%s%-25s%s %9s %9s %s\n"; + my @expand = $self->expand('Module',@args); + my $expand = scalar @expand; + if (0) { # Looks like noise to me, was very useful for debugging + # for metadata cache + $CPAN::Frontend->myprint(sprintf "%d matches in the database\n", $expand); + } + for $module (@expand) { my $file = $module->cpan_file; next unless defined $file; # ?? my($latest) = $module->cpan_version; @@ -1493,7 +1577,7 @@ sub _u_r_common { } elsif ($have == 0){ $version_zeroes++; } - next if $have >= $latest; + next unless CPAN::Version->vgt($latest, $have); # to be pedantic we should probably say: # && !($have eq "undef" && $latest ne "undef" && $latest gt ""); # to catch the case where CPAN has a version 0 and we have a version undef @@ -1524,16 +1608,34 @@ sub _u_r_common { unless ($headerdone++){ $CPAN::Frontend->myprint("\n"); $CPAN::Frontend->myprint(sprintf( - $sprintf, - "Package namespace", - "installed", - "latest", - "in CPAN file" - )); + $sprintf, + "", + "Package namespace", + "", + "installed", + "latest", + "in CPAN file" + )); } - $latest = substr($latest,0,8) if length($latest) > 8; - $have = substr($have,0,8) if length($have) > 8; - $CPAN::Frontend->myprint(sprintf $sprintf, $module->id, $have, $latest, $file); + my $color_on = ""; + my $color_off = ""; + if ( + $COLOR_REGISTERED + && + $CPAN::META->has_inst("Term::ANSIColor") + && + $module->{RO}{description} + ) { + $color_on = Term::ANSIColor::color("green"); + $color_off = Term::ANSIColor::color("reset"); + } + $CPAN::Frontend->myprint(sprintf $sprintf, + $color_on, + $module->id, + $color_off, + $have, + $latest, + $file); $need{$module->id}++; } unless (%need) { @@ -1615,52 +1717,105 @@ sub autobundle { $to\n\n"); } +#-> sub CPAN::Shell::expandany ; +sub expandany { + my($self,$s) = @_; + CPAN->debug("s[$s]") if $CPAN::DEBUG; + if ($s =~ m|/|) { # looks like a file + $s = CPAN::Distribution->normalize($s); + return $CPAN::META->instance('CPAN::Distribution',$s); + # Distributions spring into existence, not expand + } elsif ($s =~ m|^Bundle::|) { + $self->local_bundles; # scanning so late for bundles seems + # both attractive and crumpy: always + # current state but easy to forget + # somewhere + return $self->expand('Bundle',$s); + } else { + return $self->expand('Module',$s) + if $CPAN::META->exists('CPAN::Module',$s); + } + return; +} + #-> sub CPAN::Shell::expand ; sub expand { shift; my($type,@args) = @_; my($arg,@m); + CPAN->debug("type[$type]args[@args]") if $CPAN::DEBUG; for $arg (@args) { - my $regex; + my($regex,$command); if ($arg =~ m|^/(.*)/$|) { $regex = $1; - } + } elsif ($arg =~ m/=/) { + $command = 1; + } my $class = "CPAN::$type"; my $obj; + CPAN->debug(sprintf "class[%s]regex[%s]command[%s]", + $class, + defined $regex ? $regex : "UNDEFINED", + $command || "UNDEFINED", + ) if $CPAN::DEBUG; if (defined $regex) { - for $obj ( - sort - {$a->id cmp $b->id} - $CPAN::META->all_objects($class) - ) { - unless ($obj->id){ - # BUG, we got an empty object somewhere - CPAN->debug(sprintf( - "Empty id on obj[%s]%%[%s]", - $obj, - join(":", %$obj) - )) if $CPAN::DEBUG; - next; - } - push @m, $obj - if $obj->id =~ /$regex/i - or - ( - ( - $] < 5.00303 ### provide sort of - ### compatibility with 5.003 - || - $obj->can('name') - ) - && - $obj->name =~ /$regex/i - ); - } + for $obj ( + sort + {$a->id cmp $b->id} + $CPAN::META->all_objects($class) + ) { + unless ($obj->id){ + # BUG, we got an empty object somewhere + require Data::Dumper; + CPAN->debug(sprintf( + "Bug in CPAN: Empty id on obj[%s][%s]", + $obj, + Data::Dumper::Dumper($obj) + )) if $CPAN::DEBUG; + next; + } + push @m, $obj + if $obj->id =~ /$regex/i + or + ( + ( + $] < 5.00303 ### provide sort of + ### compatibility with 5.003 + || + $obj->can('name') + ) + && + $obj->name =~ /$regex/i + ); + } + } elsif ($command) { + die "equal sign in command disabled (immature interface), ". + "you can set + ! \$CPAN::Shell::ADVANCED_QUERY=1 +to enable it. But please note, this is HIGHLY EXPERIMENTAL code +that may go away anytime.\n" + unless $ADVANCED_QUERY; + my($method,$criterion) = $arg =~ /(.+?)=(.+)/; + my($matchcrit) = $criterion =~ m/^~(.+)/; + for my $self ( + sort + {$a->id cmp $b->id} + $CPAN::META->all_objects($class) + ) { + my $lhs = $self->$method() or next; # () for 5.00503 + if ($matchcrit) { + push @m, $self if $lhs =~ m/$matchcrit/; + } else { + push @m, $self if $lhs eq $criterion; + } + } } else { my($xarg) = $arg; if ( $type eq 'Bundle' ) { $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/; - } + } elsif ($type eq "Distribution") { + $xarg = CPAN::Distribution->normalize($arg); + } if ($CPAN::META->exists($class,$xarg)) { $obj = $CPAN::META->instance($class,$xarg); } elsif ($CPAN::META->exists($class,$arg)) { @@ -1680,22 +1835,33 @@ sub format_result { my($type,@args) = @_; @args = '/./' unless @args; my(@result) = $self->expand($type,@args); - my $result = @result == 1 ? + my $result = @result == 1 ? $result[0]->as_string : - join "", map {$_->as_glimpse} @result; - $result ||= "No objects of type $type found for argument @args\n"; + @result == 0 ? + "No objects of type $type found for argument @args\n" : + join("", + (map {$_->as_glimpse} @result), + scalar @result, " items found\n", + ); $result; } # The only reason for this method is currently to have a reliable # debugging utility that reveals which output is going through which # channel. No, I don't like the colors ;-) + +#-> sub CPAN::Shell::print_ornameted ; sub print_ornamented { my($self,$what,$ornament) = @_; my $longest = 0; - my $ornamenting = 0; # turn the colors on + return unless defined $what; - if ($ornamenting) { + if ($CPAN::Config->{term_is_latin}){ + # courtesy jhi: + $what + =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #}; + } + if ($PRINT_ORNAMENTING) { unless (defined &color) { if ($CPAN::META->has_inst("Term::ANSIColor")) { import Term::ANSIColor "color"; @@ -1723,6 +1889,7 @@ sub print_ornamented { sub myprint { my($self,$what) = @_; + $self->print_ornamented($what, 'bold blue on_yellow'); } @@ -1770,50 +1937,54 @@ sub rematein { } setup_output(); CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG; - my($s,@s); + + # Here is the place to set "test_count" on all involved parties to + # 0. We then can pass this counter on to the involved + # distributions and those can refuse to test if test_count > X. In + # the first stab at it we could use a 1 for "X". + + # But when do I reset the distributions to start with 0 again? + # Jost suggested to have a random or cycling interaction ID that + # we pass through. But the ID is something that is just left lying + # around in addition to the counter, so I'd prefer to set the + # counter to 0 now, and repeat at the end of the loop. But what + # about dependencies? They appear later and are not reset, they + # enter the queue but not its copy. How do they get a sensible + # test_count? + + # construct the queue + my($s,@s,@qcopy); foreach $s (@some) { - CPAN::Queue->new($s); - } - while ($s = CPAN::Queue->first) { my $obj; if (ref $s) { + CPAN->debug("s is an object[$s]") if $CPAN::DEBUG; $obj = $s; - } elsif ($s =~ m|/|) { # looks like a file - $obj = $CPAN::META->instance('CPAN::Distribution',$s); - } elsif ($s =~ m|^Bundle::|) { - $obj = $CPAN::META->instance('CPAN::Bundle',$s); + } elsif ($s =~ m|^/|) { # looks like a regexp + $CPAN::Frontend->mywarn("Sorry, $meth with a regular expression is ". + "not supported\n"); + sleep 2; + next; } else { - $obj = $CPAN::META->instance('CPAN::Module',$s) - if $CPAN::META->exists('CPAN::Module',$s); + CPAN->debug("calling expandany [$s]") if $CPAN::DEBUG; + $obj = CPAN::Shell->expandany($s); } if (ref $obj) { - CPAN->debug( - qq{pragma[$pragma]meth[$meth]obj[$obj]as_string\[}. - $obj->as_string. - qq{\]} - ) if $CPAN::DEBUG; - $obj->$pragma() - if - $pragma - && - ($] < 5.00303 || $obj->can($pragma)); ### - ### compatibility - ### with - ### 5.003 - if ($]>=5.00303 && $obj->can('called_for')) { - $obj->called_for($s); - } - CPAN::Queue->delete($s) if $obj->$meth(); # if it is more - # than once in - # the queue + $obj->color_cmd_tmps(0,1); + CPAN::Queue->new($obj->id); + push @qcopy, $obj; } elsif ($CPAN::META->exists('CPAN::Author',$s)) { $obj = $CPAN::META->instance('CPAN::Author',$s); - $CPAN::Frontend->myprint( - join "", - "Don't be silly, you can't $meth ", - $obj->fullname, - " ;-)\n" - ); + if ($meth eq "dump") { + $obj->dump; + } else { + $CPAN::Frontend->myprint( + join "", + "Don't be silly, you can't $meth ", + $obj->fullname, + " ;-)\n" + ); + sleep 2; + } } else { $CPAN::Frontend ->myprint(qq{Warning: Cannot $meth $s, }. @@ -1822,13 +1993,55 @@ Try the command i /$s/ -to find objects with similar identifiers. +to find objects with matching identifiers. }); + sleep 2; } + } + + # queuerunner (please be warned: when I started to change the + # queue to hold objects instead of names, I made one or two + # mistakes and never found which. I reverted back instead) + while ($s = CPAN::Queue->first) { + my $obj; + if (ref $s) { + $obj = $s; # I do not believe, we would survive if this happened + } else { + $obj = CPAN::Shell->expandany($s); + } + if ($pragma + && + ($] < 5.00303 || $obj->can($pragma))){ + ### compatibility with 5.003 + $obj->$pragma($meth); # the pragma "force" in + # "CPAN::Distribution" must know + # what we are intending + } + if ($]>=5.00303 && $obj->can('called_for')) { + $obj->called_for($s); + } + CPAN->debug( + qq{pragma[$pragma]meth[$meth]obj[$obj]as_string\[}. + $obj->as_string. + qq{\]} + ) if $CPAN::DEBUG; + + if ($obj->$meth()){ + CPAN::Queue->delete($s); + } else { + CPAN->debug("failed"); + } + + $obj->undelay; CPAN::Queue->delete_first($s); } + for my $obj (@qcopy) { + $obj->color_cmd_tmps(0,0); + } } +#-> sub CPAN::Shell::dump ; +sub dump { shift->rematein('dump',@_); } #-> sub CPAN::Shell::force ; sub force { shift->rematein('force',@_); } #-> sub CPAN::Shell::get ; @@ -1848,6 +2061,60 @@ sub look { shift->rematein('look',@_); } #-> sub CPAN::Shell::cvs_import ; sub cvs_import { shift->rematein('cvs_import',@_); } +package CPAN::LWP::UserAgent; + +sub config { + return if $SETUPDONE; + if ($CPAN::META->has_usable('LWP::UserAgent')) { + require LWP::UserAgent; + @ISA = qw(Exporter LWP::UserAgent); + $SETUPDONE++; + } else { + $CPAN::Frontent->mywarn("LWP::UserAgent not available\n"); + } +} + +sub get_basic_credentials { + my($self, $realm, $uri, $proxy) = @_; + return unless $proxy; + if ($USER && $PASSWD) { + } elsif (defined $CPAN::Config->{proxy_user} && + defined $CPAN::Config->{proxy_pass}) { + $USER = $CPAN::Config->{proxy_user}; + $PASSWD = $CPAN::Config->{proxy_pass}; + } else { + require ExtUtils::MakeMaker; + ExtUtils::MakeMaker->import(qw(prompt)); + $USER = prompt("Proxy authentication needed! + (Note: to permanently configure username and password run + o conf proxy_user your_username + o conf proxy_pass your_password + )\nUsername:"); + if ($CPAN::META->has_inst("Term::ReadKey")) { + Term::ReadKey::ReadMode("noecho"); + } else { + $CPAN::Frontend->mywarn("Warning: Term::ReadKey seems not to be available, your password will be echoed to the terminal!\n"); + } + $PASSWD = prompt("Password:"); + if ($CPAN::META->has_inst("Term::ReadKey")) { + Term::ReadKey::ReadMode("restore"); + } + $CPAN::Frontend->myprint("\n\n"); + } + return($USER,$PASSWD); +} + +sub mirror { + my($self,$url,$aslocal) = @_; + my $result = $self->SUPER::mirror($url,$aslocal); + if ($result->code == 407) { + undef $USER; + undef $PASSWD; + $result = $self->SUPER::mirror($url,$aslocal); + } + $result; +} + package CPAN::FTP; #-> sub CPAN::FTP::ftp_get ; @@ -1860,7 +2127,7 @@ sub ftp_get { my $ftp = Net::FTP->new($host); return 0 unless defined $ftp; $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG; - $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]); + $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]); unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){ warn "Couldn't login on $host"; return; @@ -1881,61 +2148,33 @@ sub ftp_get { # If more accuracy is wanted/needed, Chris Leach sent me this patch... - # leach,> *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997 - # leach,> --- /tmp/cp Wed Sep 24 13:26:40 1997 - # leach,> *************** - # leach,> *** 1562,1567 **** - # leach,> --- 1562,1580 ---- - # leach,> return 1 if substr($url,0,4) eq "file"; - # leach,> return 1 unless $url =~ m|://([^/]+)|; - # leach,> my $host = $1; - # leach,> + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'}; - # leach,> + if ($proxy) { - # leach,> + $proxy =~ m|://([^/:]+)|; - # leach,> + $proxy = $1; - # leach,> + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'}; - # leach,> + if ($noproxy) { - # leach,> + if ($host !~ /$noproxy$/) { - # leach,> + $host = $proxy; - # leach,> + } - # leach,> + } else { - # leach,> + $host = $proxy; - # leach,> + } - # leach,> + } - # leach,> require Net::Ping; - # leach,> return 1 unless $Net::Ping::VERSION >= 2; - # leach,> my $p; + # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997 + # > --- /tmp/cp Wed Sep 24 13:26:40 1997 + # > *************** + # > *** 1562,1567 **** + # > --- 1562,1580 ---- + # > return 1 if substr($url,0,4) eq "file"; + # > return 1 unless $url =~ m|://([^/]+)|; + # > my $host = $1; + # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'}; + # > + if ($proxy) { + # > + $proxy =~ m|://([^/:]+)|; + # > + $proxy = $1; + # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'}; + # > + if ($noproxy) { + # > + if ($host !~ /$noproxy$/) { + # > + $host = $proxy; + # > + } + # > + } else { + # > + $host = $proxy; + # > + } + # > + } + # > require Net::Ping; + # > return 1 unless $Net::Ping::VERSION >= 2; + # > my $p; -# this is quite optimistic and returns one on several occasions where -# inappropriate. But this does no harm. It would do harm if we were -# too pessimistic (as I was before the http_proxy -sub is_reachable { - my($self,$url) = @_; - return 1; # we can't simply roll our own, firewalls may break ping - return 0 unless $url; - return 1 if substr($url,0,4) eq "file"; - return 1 unless $url =~ m|^(\w+)://([^/]+)|; - my $proxytype = $1 . "_proxy"; # ftp_proxy or http_proxy - my $host = $2; - return 1 if $CPAN::Config->{$proxytype} || $ENV{$proxytype}; - require Net::Ping; - return 1 unless $Net::Ping::VERSION >= 2; - my $p; - # 1.3101 had it different: only if the first eval raised an - # exception we tried it with TCP. Now we are happy if icmp wins - # the order and return, we don't even check for $@. Thanks to - # thayer@uis.edu for the suggestion. - eval {$p = Net::Ping->new("icmp");}; - return 1 if $p && ref($p) && $p->ping($host, 10); - eval {$p = Net::Ping->new("tcp");}; - $CPAN::Frontend->mydie($@) if $@; - return $p->ping($host, 10); -} - #-> sub CPAN::FTP::localize ; -# sorry for the ugly code here, I'll clean it up as soon as Net::FTP -# is in the core sub localize { my($self,$file,$aslocal,$force) = @_; $force ||= 0; @@ -1945,9 +2184,19 @@ sub localize { if $CPAN::DEBUG; if ($^O eq 'MacOS') { + # Comment by AK on 2000-09-03: Uniq short filenames would be + # available in CHECKSUMS file my($name, $path) = File::Basename::fileparse($aslocal, ''); if (length($name) > 31) { - $name =~ s/(\.(readme(\.(gz|Z))?|(tar\.)?(gz|Z)|tgz|zip|pm\.(gz|Z)))$//; + $name =~ s/( + \.( + readme(\.(gz|Z))? | + (tar\.)?(gz|Z) | + tgz | + zip | + pm\.(gz|Z) + ) + )$//x; my $suf = $1; my $size = 31 - length($suf); while (length($name) > $size) { @@ -1973,19 +2222,42 @@ sub localize { to insufficient permissions.\n}) unless -w $aslocal_dir; # Inheritance is not easier to manage than a few if/else branches - if ($CPAN::META->has_inst('LWP::UserAgent')) { - require LWP::UserAgent; + if ($CPAN::META->has_usable('LWP::UserAgent')) { unless ($Ua) { - $Ua = LWP::UserAgent->new; - my($var); - $Ua->proxy('ftp', $var) - if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'}; - $Ua->proxy('http', $var) - if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'}; - $Ua->no_proxy($var) - if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'}; + CPAN::LWP::UserAgent->config; + eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough? + if ($@) { + $CPAN::Frontent->mywarn("CPAN::LWP::UserAgent->new dies with $@") + if $CPAN::DEBUG; + } else { + my($var); + $Ua->proxy('ftp', $var) + if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy}; + $Ua->proxy('http', $var) + if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy}; + + +# >>>>> On Wed, 13 Dec 2000 09:21:34 -0500, "Robison, Jonathon (J.M.)" said: +# +# > I note that although CPAN.pm can use proxies, it doesn't seem equipped to +# > use ones that require basic autorization. +# +# > Example of when I use it manually in my own stuff: +# +# > $ua->proxy(['http','ftp'], http://my.proxy.server:83'); +# > $req->proxy_authorization_basic("username","password"); +# > $res = $ua->request($req); +# + + $Ua->no_proxy($var) + if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy}; + } } } + $ENV{ftp_proxy} = $CPAN::Config->{ftp_proxy} if $CPAN::Config->{ftp_proxy}; + $ENV{http_proxy} = $CPAN::Config->{http_proxy} + if $CPAN::Config->{http_proxy}; + $ENV{no_proxy} = $CPAN::Config->{no_proxy} if $CPAN::Config->{no_proxy}; # Try the list of urls for each single object. We keep a record # where we did get a file from @@ -2008,14 +2280,16 @@ sub localize { ($a == $Thesite) } 0..$last; } - my($level,@levels); + my(@levels); if ($Themethod) { @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/); } else { @levels = qw/easy hard hardest/; } @levels = qw/easy/ if $^O eq 'MacOS'; - for $level (@levels) { + my($levelno); + for $levelno (0..$#levels) { + my $level = $levels[$levelno]; my $method = "host$level"; my @host_seq = $level eq "easy" ? @reordered : 0..$last; # reordered has CDROM up front @@ -2030,17 +2304,20 @@ sub localize { return $ret; } else { unlink $aslocal; + last if $CPAN::Signal; # need to cleanup } } - my(@mess); - push @mess, - qq{Please check, if the URLs I found in your configuration file \(}. - join(", ", @{$CPAN::Config->{urllist}}). - qq{\) are valid. The urllist can be edited.}, - qq{E.g. with ``o conf urllist push ftp://myurl/''}; - $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n"); - sleep 2; - $CPAN::Frontend->myprint("Cannot fetch $file\n\n"); + unless ($CPAN::Signal) { + my(@mess); + push @mess, + qq{Please check, if the URLs I found in your configuration file \(}. + join(", ", @{$CPAN::Config->{urllist}}). + qq{\) are valid. The urllist can be edited.}, + qq{E.g. with 'o conf urllist push ftp://myurl/'}; + $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n"); + sleep 2; + $CPAN::Frontend->myprint("Could not fetch $file\n"); + } if ($restore) { rename "$aslocal.bak", $aslocal; $CPAN::Frontend->myprint("Trying to get away with old file:\n" . @@ -2054,19 +2331,13 @@ sub hosteasy { my($self,$host_seq,$file,$aslocal) = @_; my($i); HOSTEASY: for $i (@$host_seq) { - my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite; - unless ($self->is_reachable($url)) { - $CPAN::Frontend->myprint("Skipping $url (seems to be not reachable)\n"); - sleep 2; - next; - } + my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite; $url .= "/" unless substr($url,-1) eq "/"; $url .= $file; $self->debug("localizing perlish[$url]") if $CPAN::DEBUG; if ($url =~ /^file:/) { my $l; - if ($CPAN::META->has_inst('LWP')) { - require URI::URL; + if ($CPAN::META->has_inst('URI::URL')) { my $u = URI::URL->new($url); $l = $u->path; } else { # works only on Unix, is poorly constructed, but @@ -2080,6 +2351,7 @@ sub hosteasy { # meant # file://localhost $l =~ s|^/||s unless -f $l; # e.g. /P: + $self->debug("without URI::URL we try local file $l") if $CPAN::DEBUG; } if ( -f $l && -r _) { $Thesite = $i; @@ -2095,13 +2367,16 @@ sub hosteasy { } } } - if ($CPAN::META->has_inst('LWP')) { + if ($CPAN::META->has_usable('LWP')) { $CPAN::Frontend->myprint("Fetching with LWP: $url "); unless ($Ua) { - require LWP::UserAgent; - $Ua = LWP::UserAgent->new; + CPAN::LWP::UserAgent->config; + eval { $Ua = CPAN::LWP::UserAgent->new; }; + if ($@) { + $CPAN::Frontent->mywarn("CPAN::LWP::UserAgent->new dies with $@"); + } } my $res = $Ua->mirror($url, $aslocal); if ($res->is_success) { @@ -2110,7 +2385,7 @@ sub hosteasy { utime $now, $now, $aslocal; # download time is more # important than upload time return $aslocal; - } elsif ($url !~ /\.gz\z/) { + } elsif ($url !~ /\.gz(?!\n)\Z/) { my $gzurl = "$url.gz"; $CPAN::Frontend->myprint("Fetching with LWP: $gzurl @@ -2121,22 +2396,25 @@ sub hosteasy { ) { $Thesite = $i; return $aslocal; - } else { - # next HOSTEASY ; } } else { - # Alan Burlison informed me that in firewall envs Net::FTP - # can still succeed where LWP fails. So we do not skip - # Net::FTP anymore when LWP is available. - # next HOSTEASY ; + $CPAN::Frontend->myprint(sprintf( + "LWP failed with code[%s] message[%s]\n", + $res->code, + $res->message, + )); + # Alan Burlison informed me that in firewall environments + # Net::FTP can still succeed where LWP fails. So we do not + # skip Net::FTP anymore when LWP is available. } } else { - $self->debug("LWP not installed") if $CPAN::DEBUG; + $CPAN::Frontend->myprint("LWP not available\n"); } + return if $CPAN::Signal; if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) { # that's the nice and easy way thanks to Graham my($host,$dir,$getfile) = ($1,$2,$3); - if ($CPAN::META->has_inst('Net::FTP')) { + if ($CPAN::META->has_usable('Net::FTP')) { $dir =~ s|/+|/|g; $CPAN::Frontend->myprint("Fetching with Net::FTP: $url @@ -2147,7 +2425,7 @@ sub hosteasy { $Thesite = $i; return $aslocal; } - if ($aslocal !~ /\.gz\z/) { + if ($aslocal !~ /\.gz(?!\n)\Z/) { my $gz = "$aslocal.gz"; $CPAN::Frontend->myprint("Fetching with Net::FTP $url.gz @@ -2165,6 +2443,7 @@ sub hosteasy { # next HOSTEASY; } } + return if $CPAN::Signal; } } @@ -2182,10 +2461,6 @@ sub hosthard { File::Path::mkpath($aslocal_dir); HOSTHARD: for $i (@$host_seq) { my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite; - unless ($self->is_reachable($url)) { - $CPAN::Frontend->myprint("Skipping $url (not reachable)\n"); - next; - } $url .= "/" unless substr($url,-1) eq "/"; $url .= $file; my($proto,$host,$dir,$getfile); @@ -2199,91 +2474,90 @@ sub hosthard { } else { next HOSTHARD; # who said, we could ftp anything except ftp? } + next HOSTHARD if $proto eq "file"; # file URLs would have had + # success above. Likely a bogus URL $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG; my($f,$funkyftp); - for $f ('lynx','ncftpget','ncftp') { + for $f ('lynx','ncftpget','ncftp','wget') { next unless exists $CPAN::Config->{$f}; $funkyftp = $CPAN::Config->{$f}; next unless defined $funkyftp; next if $funkyftp =~ /^\s*$/; - my($want_compressed); - my $aslocal_uncompressed; - ($aslocal_uncompressed = $aslocal) =~ s/\.gz//; - my($source_switch) = ""; + my($asl_ungz, $asl_gz); + ($asl_ungz = $aslocal) =~ s/\.gz//; + $asl_gz = "$asl_ungz.gz"; + my($src_switch) = ""; if ($f eq "lynx"){ - $source_switch = " -source"; + $src_switch = " -source"; } elsif ($f eq "ncftp"){ - $source_switch = " -c"; + $src_switch = " -c"; + } elsif ($f eq "wget"){ + $src_switch = " -O -"; } my($chdir) = ""; - my($stdout_redir) = " > $aslocal_uncompressed"; + my($stdout_redir) = " > $asl_ungz"; if ($f eq "ncftpget"){ $chdir = "cd $aslocal_dir && "; $stdout_redir = ""; } $CPAN::Frontend->myprint( qq[ -Trying with "$funkyftp$source_switch" to get +Trying with "$funkyftp$src_switch" to get $url ]); my($system) = - "$chdir$funkyftp$source_switch '$url' $devnull$stdout_redir"; + "$chdir$funkyftp$src_switch '$url' $devnull$stdout_redir"; $self->debug("system[$system]") if $CPAN::DEBUG; my($wstatus); if (($wstatus = system($system)) == 0 && ($f eq "lynx" ? - -s $aslocal_uncompressed # lynx returns 0 on my - # system even if it fails + -s $asl_ungz # lynx returns 0 when it fails somewhere : 1 ) ) { if (-s $aslocal) { # Looks good - } elsif ($aslocal_uncompressed ne $aslocal) { + } elsif ($asl_ungz ne $aslocal) { # test gzip integrity - if ( - CPAN::Tarzip->gtest($aslocal_uncompressed) - ) { - rename $aslocal_uncompressed, $aslocal; + if (CPAN::Tarzip->gtest($asl_ungz)) { + # e.g. foo.tar is gzipped --> foo.tar.gz + rename $asl_ungz, $aslocal; } else { - CPAN::Tarzip->gzip($aslocal_uncompressed, - "$aslocal_uncompressed.gz"); + CPAN::Tarzip->gzip($asl_ungz,$asl_gz); } } $Thesite = $i; return $aslocal; - } elsif ($url !~ /\.gz\z/) { - unlink $aslocal_uncompressed if - -f $aslocal_uncompressed && -s _ == 0; + } elsif ($url !~ /\.gz(?!\n)\Z/) { + unlink $asl_ungz if + -f $asl_ungz && -s _ == 0; my $gz = "$aslocal.gz"; my $gzurl = "$url.gz"; $CPAN::Frontend->myprint( qq[ -Trying with "$funkyftp$source_switch" to get +Trying with "$funkyftp$src_switch" to get $url.gz ]); - my($system) = "$funkyftp$source_switch '$url.gz' $devnull > ". - "$aslocal_uncompressed.gz"; + my($system) = "$funkyftp$src_switch '$url.gz' $devnull > $asl_gz"; $self->debug("system[$system]") if $CPAN::DEBUG; my($wstatus); if (($wstatus = system($system)) == 0 && - -s "$aslocal_uncompressed.gz" + -s $asl_gz ) { # test gzip integrity - if (CPAN::Tarzip->gtest("$aslocal_uncompressed.gz")) { - CPAN::Tarzip->gunzip("$aslocal_uncompressed.gz", - $aslocal); + if (CPAN::Tarzip->gtest($asl_gz)) { + CPAN::Tarzip->gunzip($asl_gz,$aslocal); } else { - rename $aslocal_uncompressed, $aslocal; + # somebody uncompressed file for us? + rename $asl_ungz, $aslocal; } $Thesite = $i; return $aslocal; } else { - unlink "$aslocal_uncompressed.gz" if - -f "$aslocal_uncompressed.gz"; + unlink $asl_gz if -f $asl_gz; } } else { my $estatus = $wstatus >> 8; @@ -2295,8 +2569,9 @@ System call "$system" returned status $estatus (wstat $wstatus)$size }); } - } - } + return if $CPAN::Signal; + } # lynx,ncftpget,ncftp + } # host } sub hosthardest { @@ -2311,10 +2586,6 @@ sub hosthardest { last HOSTHARDEST; } my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite; - unless ($self->is_reachable($url)) { - $CPAN::Frontend->myprint("Skipping $url (not reachable)\n"); - next; - } $url .= "/" unless substr($url,-1) eq "/"; $url .= $file; $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG; @@ -2367,6 +2638,7 @@ sub hosthardest { } else { $CPAN::Frontend->myprint("Hmm... Still failed!\n"); } + return if $CPAN::Signal; } else { $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }. qq{correctly protected.\n}); @@ -2396,9 +2668,10 @@ sub hosthardest { } else { $CPAN::Frontend->myprint("Bad luck... Still failed!\n"); } + return if $CPAN::Signal; $CPAN::Frontend->myprint("Can't access URL $url.\n\n"); sleep 2; - } + } # host } sub talk_ftp { @@ -2526,6 +2799,7 @@ sub new { }, $class; } +# CPAN::FTP::hasdefault; sub hasdefault { shift->{'hasdefault'} } sub netrc { shift->{'netrc'} } sub protected { shift->{'protected'} } @@ -2573,22 +2847,22 @@ sub cpl { } my @return; if ($pos == 0) { - @return = grep( - /^$word/, - sort qw( - ! a b d h i m o q r u autobundle clean - make test install force reload look cvs_import - ) - ); - } elsif ( $line !~ /^[\!abcdhimorutl]/ ) { + @return = grep /^$word/, @CPAN::Complete::COMMANDS; + } elsif ( $line !~ /^[\!abcdghimorutl]/ ) { @return = (); - } elsif ($line =~ /^a\s/) { - @return = cplx('CPAN::Author',$word); + } elsif ($line =~ /^(a|ls)\s/) { + @return = cplx('CPAN::Author',uc($word)); } elsif ($line =~ /^b\s/) { + CPAN::Shell->local_bundles; @return = cplx('CPAN::Bundle',$word); } elsif ($line =~ /^d\s/) { @return = cplx('CPAN::Distribution',$word); - } elsif ($line =~ /^([mru]|make|clean|test|install|readme|look|cvs_import)\s/ ) { + } elsif ($line =~ m/^( + [mru]|make|clean|dump|get|test|install|readme|look|cvs_import + )\s/x ) { + if ($word =~ /^Bundle::/) { + CPAN::Shell->local_bundles; + } @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word)); } elsif ($line =~ /^i\s/) { @return = cpl_any($word); @@ -2596,6 +2870,9 @@ sub cpl { @return = cpl_reload($word,$line,$pos); } elsif ($line =~ /^o\s/) { @return = cpl_option($word,$line,$pos); + } elsif ($line =~ m/^\S+\s/ ) { + # fallback for future commands and what we have forgotten above + @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word)); } else { @return = (); } @@ -2605,7 +2882,11 @@ sub cpl { #-> sub CPAN::Complete::cplx ; sub cplx { my($class, $word) = @_; - grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class); + # I believed for many years that this was sorted, today I + # realized, it wasn't sorted anymore. Now (rev 1.301 / v 1.55) I + # make it sorted again. Maybe sort was dropped when GNU-readline + # support came in? The RCS file is difficult to read on that:-( + sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class); } #-> sub CPAN::Complete::cpl_any ; @@ -2654,7 +2935,7 @@ package CPAN::Index; #-> sub CPAN::Index::force_reload ; sub force_reload { my($class) = @_; - $CPAN::Index::last_time = 0; + $CPAN::Index::LAST_TIME = 0; $class->reload(1); } @@ -2668,51 +2949,71 @@ sub reload { for ($CPAN::Config->{index_expire}) { $_ = 0.001 unless $_ && $_ > 0.001; } - return if $last_time + $CPAN::Config->{index_expire}*86400 > $time + unless (1 || $CPAN::Have_warned->{readmetadatacache}++) { + # debug here when CPAN doesn't seem to read the Metadata + require Carp; + Carp::cluck("META-PROTOCOL[$CPAN::META->{PROTOCOL}]"); + } + unless ($CPAN::META->{PROTOCOL}) { + $cl->read_metadata_cache; + $CPAN::META->{PROTOCOL} ||= "1.0"; + } + if ( $CPAN::META->{PROTOCOL} < PROTOCOL ) { + # warn "Setting last_time to 0"; + $LAST_TIME = 0; # No warning necessary + } + return if $LAST_TIME + $CPAN::Config->{index_expire}*86400 > $time and ! $force; - ## IFF we are developing, it helps to wipe out the memory between - ## reloads, otherwise it is not what a user expects. + if (0) { + # IFF we are developing, it helps to wipe out the memory + # between reloads, otherwise it is not what a user expects. + undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274) + $CPAN::META = CPAN->new; + } + { + my($debug,$t2); + local $LAST_TIME = $time; + local $CPAN::META->{PROTOCOL} = PROTOCOL; - ## undef $CPAN::META; # Neue Gruendlichkeit since v1.52(r1.274) - ## $CPAN::META = CPAN->new; - my($debug,$t2); - $last_time = $time; + my $needshort = $^O eq "dos"; - my $needshort = $^O eq "dos"; - - $cl->rd_authindex($cl - ->reload_x( - "authors/01mailrc.txt.gz", - $needshort ? - File::Spec->catfile('authors', '01mailrc.gz') : - File::Spec->catfile('authors', '01mailrc.txt.gz'), - $force)); - $t2 = time; - $debug = "timing reading 01[".($t2 - $time)."]"; - $time = $t2; - return if $CPAN::Signal; # this is sometimes lengthy - $cl->rd_modpacks($cl - ->reload_x( - "modules/02packages.details.txt.gz", - $needshort ? - File::Spec->catfile('modules', '02packag.gz') : - File::Spec->catfile('modules', '02packages.details.txt.gz'), - $force)); - $t2 = time; - $debug .= "02[".($t2 - $time)."]"; - $time = $t2; - return if $CPAN::Signal; # this is sometimes lengthy - $cl->rd_modlist($cl - ->reload_x( - "modules/03modlist.data.gz", - $needshort ? - File::Spec->catfile('modules', '03mlist.gz') : - File::Spec->catfile('modules', '03modlist.data.gz'), - $force)); - $t2 = time; - $debug .= "03[".($t2 - $time)."]"; - $time = $t2; - CPAN->debug($debug) if $CPAN::DEBUG; + $cl->rd_authindex($cl + ->reload_x( + "authors/01mailrc.txt.gz", + $needshort ? + File::Spec->catfile('authors', '01mailrc.gz') : + File::Spec->catfile('authors', '01mailrc.txt.gz'), + $force)); + $t2 = time; + $debug = "timing reading 01[".($t2 - $time)."]"; + $time = $t2; + return if $CPAN::Signal; # this is sometimes lengthy + $cl->rd_modpacks($cl + ->reload_x( + "modules/02packages.details.txt.gz", + $needshort ? + File::Spec->catfile('modules', '02packag.gz') : + File::Spec->catfile('modules', '02packages.details.txt.gz'), + $force)); + $t2 = time; + $debug .= "02[".($t2 - $time)."]"; + $time = $t2; + return if $CPAN::Signal; # this is sometimes lengthy + $cl->rd_modlist($cl + ->reload_x( + "modules/03modlist.data.gz", + $needshort ? + File::Spec->catfile('modules', '03mlist.gz') : + File::Spec->catfile('modules', '03modlist.data.gz'), + $force)); + $cl->write_metadata_cache; + $t2 = time; + $debug .= "03[".($t2 - $time)."]"; + $time = $t2; + CPAN->debug($debug) if $CPAN::DEBUG; + } + $LAST_TIME = $time; + $CPAN::META->{PROTOCOL} = PROTOCOL; } #-> sub CPAN::Index::reload_x ; @@ -2745,9 +3046,6 @@ sub rd_authindex { my @lines; return unless defined $index_target; $CPAN::Frontend->myprint("Going to read $index_target\n"); -# my $fh = CPAN::Tarzip->TIEHANDLE($index_target); -# while ($_ = $fh->READLINE) { - # no strict 'refs'; local(*FH); tie *FH, CPAN::Tarzip, $index_target; local($/) = "\n"; @@ -2773,7 +3071,7 @@ sub userid { #-> sub CPAN::Index::rd_modpacks ; sub rd_modpacks { - my($cl, $index_target) = @_; + my($self, $index_target) = @_; my @lines; return unless defined $index_target; $CPAN::Frontend->myprint("Going to read $index_target\n"); @@ -2785,16 +3083,78 @@ sub rd_modpacks { unshift @ls, "\n" x length($1) if /^(\n+)/; push @lines, @ls; } + # read header + my($line_count,$last_updated); while (@lines) { my $shift = shift(@lines); last if $shift =~ /^\s*$/; + $shift =~ /^Line-Count:\s+(\d+)/ and $line_count = $1; + $shift =~ /^Last-Updated:\s+(.+)/ and $last_updated = $1; } + if (not defined $line_count) { + + warn qq{Warning: Your $index_target does not contain a Line-Count header. +Please check the validity of the index file by comparing it to more +than one CPAN mirror. I'll continue but problems seem likely to +happen.\a +}; + + sleep 5; + } elsif ($line_count != scalar @lines) { + + warn sprintf qq{Warning: Your %s +contains a Line-Count header of %d but I see %d lines there. Please +check the validity of the index file by comparing it to more than one +CPAN mirror. I'll continue but problems seem likely to happen.\a\n}, +$index_target, $line_count, scalar(@lines); + + } + if (not defined $last_updated) { + + warn qq{Warning: Your $index_target does not contain a Last-Updated header. +Please check the validity of the index file by comparing it to more +than one CPAN mirror. I'll continue but problems seem likely to +happen.\a +}; + + sleep 5; + } else { + + $CPAN::Frontend + ->myprint(sprintf qq{ Database was generated on %s\n}, + $last_updated); + $DATE_OF_02 = $last_updated; + + if ($CPAN::META->has_inst(HTTP::Date)) { + require HTTP::Date; + my($age) = (time - HTTP::Date::str2time($last_updated))/3600/24; + if ($age > 30) { + + $CPAN::Frontend + ->mywarn(sprintf + qq{Warning: This index file is %d days old. + Please check the host you chose as your CPAN mirror for staleness. + I'll continue but problems seem likely to happen.\a\n}, + $age); + + } + } else { + $CPAN::Frontend->myprint(" HTTP::Date not available\n"); + } + } + + + # A necessity since we have metadata_cache: delete what isn't + # there anymore + my $secondtime = $CPAN::META->exists("CPAN::Module","CPAN"); + CPAN->debug("secondtime[$secondtime]") if $CPAN::DEBUG; + my(%exists); foreach (@lines) { chomp; - my($mod,$version,$dist) = split; -### $version =~ s/^\+//; - - # if it is a bundle, instantiate a bundle object + # before 1.56 we split into 3 and discarded the rest. From + # 1.57 we assign remaining text to $comment thus allowing to + # influence isa_perl + my($mod,$version,$dist,$comment) = split " ", $_, 4; my($bundle,$id,$userid); if ($mod eq 'CPAN' && @@ -2803,18 +3163,18 @@ sub rd_modpacks { CPAN::Queue->exists('CPAN') ) ) { - local($^W)= 0; - if ($version > $CPAN::VERSION){ - $CPAN::Frontend->myprint(qq{ - There\'s a new CPAN.pm version (v$version) available! + local($^W)= 0; + if ($version > $CPAN::VERSION){ + $CPAN::Frontend->myprint(qq{ + There's a new CPAN.pm version (v$version) available! [Current version is v$CPAN::VERSION] You might want to try install Bundle::CPAN reload cpan without quitting the current session. It should be a seamless upgrade while we are running... -}); - sleep 2; +}); #}); + sleep 2; $CPAN::Frontend->myprint(qq{\n}); } last if $CPAN::Signal; @@ -2824,29 +3184,29 @@ sub rd_modpacks { if ($bundle){ $id = $CPAN::META->instance('CPAN::Bundle',$mod); - # warn "made mod[$mod]a bundle"; # Let's make it a module too, because bundles have so much - # in common with modules - $CPAN::META->instance('CPAN::Module',$mod); - # warn "made mod[$mod]a module"; + # in common with modules. -# This "next" makes us faster but if the job is running long, we ignore -# rereads which is bad. So we have to be a bit slower again. -# } elsif ($CPAN::META->exists('CPAN::Module',$mod)) { -# next; + # Changed in 1.57_63: seems like memory bloat now without + # any value, so commented out + + # $CPAN::META->instance('CPAN::Module',$mod); + + } else { - } - else { # instantiate a module object $id = $CPAN::META->instance('CPAN::Module',$mod); + } - if ($id->cpan_file ne $dist){ - $userid = $cl->userid($dist); + if ($id->cpan_file ne $dist){ # update only if file is + # different. CPAN prohibits same + # name with different version + $userid = $self->userid($dist); $id->set( 'CPAN_USERID' => $userid, 'CPAN_VERSION' => $version, - 'CPAN_FILE' => $dist + 'CPAN_FILE' => $dist, ); } @@ -2863,13 +3223,29 @@ sub rd_modpacks { $CPAN::META->instance( 'CPAN::Distribution' => $dist )->set( - 'CPAN_USERID' => $userid + 'CPAN_USERID' => $userid, + 'CPAN_COMMENT' => $comment, ); } - + if ($secondtime) { + for my $name ($mod,$dist) { + CPAN->debug("exists name[$name]") if $CPAN::DEBUG; + $exists{$name} = undef; + } + } return if $CPAN::Signal; } undef $fh; + if ($secondtime) { + for my $class (qw(CPAN::Module CPAN::Bundle CPAN::Distribution)) { + for my $o ($CPAN::META->all_objects($class)) { + next if exists $exists{$o->{ID}}; + $CPAN::META->delete($class,$o->{ID}); + CPAN->debug("deleting ID[$o->{ID}] in class[$class]") + if $CPAN::DEBUG; + } + } + } } #-> sub CPAN::Index::rd_modlist ; @@ -2889,8 +3265,8 @@ sub rd_modlist { while (@eval) { my $shift = shift(@eval); if ($shift =~ /^Date:\s+(.*)/){ - return if $date_of_03 eq $1; - ($date_of_03) = $1; + return if $DATE_OF_03 eq $1; + ($DATE_OF_03) = $1; } last if $shift =~ /^\s*$/; } @@ -2903,26 +3279,132 @@ sub rd_modlist { Carp::confess($@) if $@; return if $CPAN::Signal; for (keys %$ret) { - my $obj = $CPAN::META->instance(CPAN::Module,$_); + my $obj = $CPAN::META->instance("CPAN::Module",$_); + delete $ret->{$_}{modid}; # not needed here, maybe elsewhere $obj->set(%{$ret->{$_}}); return if $CPAN::Signal; } } +#-> sub CPAN::Index::write_metadata_cache ; +sub write_metadata_cache { + my($self) = @_; + return unless $CPAN::Config->{'cache_metadata'}; + return unless $CPAN::META->has_usable("Storable"); + my $cache; + foreach my $k (qw(CPAN::Bundle CPAN::Author CPAN::Module + CPAN::Distribution)) { + $cache->{$k} = $CPAN::META->{readonly}{$k}; # unsafe meta access, ok + } + my $metadata_file = MM->catfile($CPAN::Config->{cpan_home},"Metadata"); + $cache->{last_time} = $LAST_TIME; + $cache->{DATE_OF_02} = $DATE_OF_02; + $cache->{PROTOCOL} = PROTOCOL; + $CPAN::Frontend->myprint("Going to write $metadata_file\n"); + eval { Storable::nstore($cache, $metadata_file) }; + $CPAN::Frontend->mywarn($@) if $@; +} + +#-> sub CPAN::Index::read_metadata_cache ; +sub read_metadata_cache { + my($self) = @_; + return unless $CPAN::Config->{'cache_metadata'}; + return unless $CPAN::META->has_usable("Storable"); + my $metadata_file = MM->catfile($CPAN::Config->{cpan_home},"Metadata"); + return unless -r $metadata_file and -f $metadata_file; + $CPAN::Frontend->myprint("Going to read $metadata_file\n"); + my $cache; + eval { $cache = Storable::retrieve($metadata_file) }; + $CPAN::Frontend->mywarn($@) if $@; + if (!$cache || ref $cache ne 'HASH'){ + $LAST_TIME = 0; + return; + } + if (exists $cache->{PROTOCOL}) { + if (PROTOCOL > $cache->{PROTOCOL}) { + $CPAN::Frontend->mywarn(sprintf("Ignoring Metadata cache written ". + "with protocol v%s, requiring v%s", + $cache->{PROTOCOL}, + PROTOCOL) + ); + return; + } + } else { + $CPAN::Frontend->mywarn("Ignoring Metadata cache written ". + "with protocol v1.0"); + return; + } + my $clcnt = 0; + my $idcnt = 0; + while(my($class,$v) = each %$cache) { + next unless $class =~ /^CPAN::/; + $CPAN::META->{readonly}{$class} = $v; # unsafe meta access, ok + while (my($id,$ro) = each %$v) { + $CPAN::META->{readwrite}{$class}{$id} ||= + $class->new(ID=>$id, RO=>$ro); + $idcnt++; + } + $clcnt++; + } + unless ($clcnt) { # sanity check + $CPAN::Frontend->myprint("Warning: Found no data in $metadata_file\n"); + return; + } + if ($idcnt < 1000) { + $CPAN::Frontend->myprint("Warning: Found only $idcnt objects ". + "in $metadata_file\n"); + return; + } + $CPAN::META->{PROTOCOL} ||= + $cache->{PROTOCOL}; # reading does not up or downgrade, but it + # does initialize to some protocol + $LAST_TIME = $cache->{last_time}; + $DATE_OF_02 = $cache->{DATE_OF_02}; + $CPAN::Frontend->myprint(" Database was generated on $DATE_OF_02\n"); + return; +} + package CPAN::InfoObj; +# Accessors +sub cpan_userid { shift->{RO}{CPAN_USERID} } +sub id { shift->{ID}; } + #-> sub CPAN::InfoObj::new ; -sub new { my $this = bless {}, shift; %$this = @_; $this } +sub new { + my $this = bless {}, shift; + %$this = @_; + $this +} + +# The set method may only be used by code that reads index data or +# otherwise "objective" data from the outside world. All session +# related material may do anything else with instance variables but +# must not touch the hash under the RO attribute. The reason is that +# the RO hash gets written to Metadata file and is thus persistent. #-> sub CPAN::InfoObj::set ; sub set { my($self,%att) = @_; - my(%oldatt) = %$self; - %$self = (%oldatt, %att); -} + my $class = ref $self; -#-> sub CPAN::InfoObj::id ; -sub id { shift->{'ID'} } + # This must be ||=, not ||, because only if we write an empty + # reference, only then the set method will write into the readonly + # area. But for Distributions that spring into existence, maybe + # because of a typo, we do not like it that they are written into + # the readonly area and made permanent (at least for a while) and + # that is why we do not "allow" other places to call ->set. + unless ($self->id) { + CPAN->debug("Bug? Empty ID, rejecting"); + return; + } + my $ro = $self->{RO} = + $CPAN::META->{readonly}{$class}{$self->id} ||= {}; + + while (my($k,$v) = each %att) { + $ro->{$k} = $v; + } +} #-> sub CPAN::InfoObj::as_glimpse ; sub as_glimpse { @@ -2941,31 +3423,39 @@ sub as_string { my $class = ref($self); $class =~ s/^CPAN:://; push @m, $class, " id = $self->{ID}\n"; - for (sort keys %$self) { - next if $_ eq 'ID'; + for (sort keys %{$self->{RO}}) { + # next if m/^(ID|RO)$/; my $extra = ""; if ($_ eq "CPAN_USERID") { - $extra .= " (".$self->author; - my $email; # old perls! - if ($email = $CPAN::META->instance(CPAN::Author, - $self->{$_} - )->email) { - $extra .= " <$email>"; - } else { - $extra .= " "; - } - $extra .= ")"; - } - if (ref($self->{$_}) eq "ARRAY") { # language interface? XXX - push @m, sprintf " %-12s %s%s\n", $_, "@{$self->{$_}}", $extra; + $extra .= " (".$self->author; + my $email; # old perls! + if ($email = $CPAN::META->instance("CPAN::Author", + $self->cpan_userid + )->email) { + $extra .= " <$email>"; + } else { + $extra .= " "; + } + $extra .= ")"; + } elsif ($_ eq "FULLNAME") { # potential UTF-8 conversion + push @m, sprintf " %-12s %s\n", $_, $self->fullname; + next; + } + next unless defined $self->{RO}{$_}; + push @m, sprintf " %-12s %s%s\n", $_, $self->{RO}{$_}, $extra; + } + for (sort keys %$self) { + next if m/^(ID|RO)$/; + if (ref($self->{$_}) eq "ARRAY") { + push @m, sprintf " %-12s %s\n", $_, "@{$self->{$_}}"; } elsif (ref($self->{$_}) eq "HASH") { push @m, sprintf( - " %-12s %s%s\n", + " %-12s %s\n", $_, join(" ",keys %{$self->{$_}}), - $extra); + ); } else { - push @m, sprintf " %-12s %s%s\n", $_, $self->{$_}, $extra; + push @m, sprintf " %-12s %s\n", $_, $self->{$_}; } } join "", @m, "\n"; @@ -2974,42 +3464,204 @@ sub as_string { #-> sub CPAN::InfoObj::author ; sub author { my($self) = @_; - $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname; + $CPAN::META->instance("CPAN::Author",$self->cpan_userid)->fullname; } +#-> sub CPAN::InfoObj::dump ; sub dump { my($self) = @_; require Data::Dumper; - Data::Dumper::Dumper($self); + print Data::Dumper::Dumper($self); } package CPAN::Author; +#-> sub CPAN::Author::id +sub id { + my $self = shift; + my $id = $self->{ID}; + $CPAN::Frontend->mydie("Illegal author id[$id]") unless $id =~ /^[A-Z]/; + $id; +} + #-> sub CPAN::Author::as_glimpse ; sub as_glimpse { my($self) = @_; my(@m); my $class = ref($self); $class =~ s/^CPAN:://; - push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname; + push @m, sprintf(qq{%-15s %s ("%s" <%s>)\n}, + $class, + $self->{ID}, + $self->fullname, + $self->email); join "", @m; } -# Dead code, I would have liked to have,,, but it was never reached,,, -#sub make { -# my($self) = @_; -# return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n"; -#} - #-> sub CPAN::Author::fullname ; -sub fullname { shift->{'FULLNAME'} } +sub fullname { + shift->{RO}{FULLNAME}; +} *name = \&fullname; #-> sub CPAN::Author::email ; -sub email { shift->{'EMAIL'} } +sub email { shift->{RO}{EMAIL}; } + +#-> sub CPAN::Author::ls ; +sub ls { + my $self = shift; + my $id = $self->id; + + # adapted from CPAN::Distribution::verifyMD5 ; + my(@csf); # chksumfile + @csf = $self->id =~ /(.)(.)(.*)/; + $csf[1] = join "", @csf[0,1]; + $csf[2] = join "", @csf[1,2]; + my(@dl); + @dl = $self->dir_listing([$csf[0],"CHECKSUMS"], 0); + unless (grep {$_->[2] eq $csf[1]} @dl) { + $CPAN::Frontend->myprint("No files in the directory of $id\n"); + return; + } + @dl = $self->dir_listing([@csf[0,1],"CHECKSUMS"], 0); + unless (grep {$_->[2] eq $csf[2]} @dl) { + $CPAN::Frontend->myprint("No files in the directory of $id\n"); + return; + } + @dl = $self->dir_listing([@csf,"CHECKSUMS"], 1); + $CPAN::Frontend->myprint(join "", map { + sprintf("%8d %10s %s/%s\n", $_->[0], $_->[1], $id, $_->[2]) + } sort { $a->[2] cmp $b->[2] } @dl); +} + +# returns an array of arrays, the latter contain (size,mtime,filename) +#-> sub CPAN::Author::dir_listing ; +sub dir_listing { + my $self = shift; + my $chksumfile = shift; + my $recursive = shift; + my $lc_want = + MM->catfile($CPAN::Config->{keep_source_where}, + "authors", "id", @$chksumfile); + local($") = "/"; + # connect "force" argument with "index_expire". + my $force = 0; + if (my @stat = stat $lc_want) { + $force = $stat[9] + $CPAN::Config->{index_expire}*86400 <= time; + } + my $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile", + $lc_want,$force); + unless ($lc_file) { + $CPAN::Frontend->myprint("Trying $lc_want.gz\n"); + $chksumfile->[-1] .= ".gz"; + $lc_file = CPAN::FTP->localize("authors/id/@$chksumfile", + "$lc_want.gz",1); + if ($lc_file) { + $lc_file =~ s{\.gz(?!\n)\Z}{}; #}; + CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file); + } else { + return; + } + } + + # adapted from CPAN::Distribution::MD5_check_file ; + my $fh = FileHandle->new; + my($cksum); + if (open $fh, $lc_file){ + local($/); + my $eval = <$fh>; + $eval =~ s/\015?\012/\n/g; + close $fh; + my($comp) = Safe->new(); + $cksum = $comp->reval($eval); + if ($@) { + rename $lc_file, "$lc_file.bad"; + Carp::confess($@) if $@; + } + } else { + Carp::carp "Could not open $lc_file for reading"; + } + my(@result,$f); + for $f (sort keys %$cksum) { + if (exists $cksum->{$f}{isdir}) { + if ($recursive) { + my(@dir) = @$chksumfile; + pop @dir; + push @dir, $f, "CHECKSUMS"; + push @result, map { + [$_->[0], $_->[1], "$f/$_->[2]"] + } $self->dir_listing(\@dir,1); + } else { + push @result, [ 0, "-", $f ]; + } + } else { + push @result, [ + ($cksum->{$f}{"size"}||0), + $cksum->{$f}{"mtime"}||"---", + $f + ]; + } + } + @result; +} package CPAN::Distribution; +# Accessors +sub cpan_comment { shift->{RO}{CPAN_COMMENT} } + +sub undelay { + my $self = shift; + delete $self->{later}; +} + +# CPAN::Distribution::normalize +sub normalize { + my($self,$s) = @_; + $s = $self->id unless defined $s; + if ( + $s =~ tr|/|| == 1 + or + $s !~ m|[A-Z]/[A-Z-]{2}/[A-Z-]{2,}/| + ) { + return $s if $s =~ m:^N/A|^Contact Author: ; + $s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4| or + $CPAN::Frontend->mywarn("Strange distribution name [$s]"); + CPAN->debug("s[$s]") if $CPAN::DEBUG; + } + $s; +} + +#-> sub CPAN::Distribution::color_cmd_tmps ; +sub color_cmd_tmps { + my($self) = shift; + my($depth) = shift || 0; + my($color) = shift || 0; + # a distribution needs to recurse into its prereq_pms + + return if exists $self->{incommandcolor} + && $self->{incommandcolor}==$color; + $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ". + "color_cmd_tmps depth[%s] self[%s] id[%s]", + $depth, + $self, + $self->id + )) if $depth>=100; + ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1; + my $prereq_pm = $self->prereq_pm; + if (defined $prereq_pm) { + for my $pre (keys %$prereq_pm) { + my $premo = CPAN::Shell->expand("Module",$pre); + $premo->color_cmd_tmps($depth+1,$color); + } + } + if ($color==0) { + delete $self->{sponsored_mods}; + delete $self->{badtestcnt}; + } + $self->{incommandcolor} = $color; +} + #-> sub CPAN::Distribution::as_string ; sub as_string { my $self = shift; @@ -3020,20 +3672,50 @@ sub as_string { #-> sub CPAN::Distribution::containsmods ; sub containsmods { my $self = shift; - return if exists $self->{CONTAINSMODS}; + return keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS}; + my $dist_id = $self->{ID}; for my $mod ($CPAN::META->all_objects("CPAN::Module")) { - my $mod_file = $mod->{CPAN_FILE} or next; - my $dist_id = $self->{ID} or next; + my $mod_file = $mod->cpan_file or next; my $mod_id = $mod->{ID} or next; + # warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]"; + # sleep 1; $self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id; } + keys %{$self->{CONTAINSMODS}}; +} + +#-> sub CPAN::Distribution::uptodate ; +sub uptodate { + my($self) = @_; + my $c; + foreach $c ($self->containsmods) { + my $obj = CPAN::Shell->expandany($c); + return 0 unless $obj->uptodate; + } + return 1; } #-> sub CPAN::Distribution::called_for ; sub called_for { my($self,$id) = @_; - $self->{'CALLED_FOR'} = $id if defined $id; - return $self->{'CALLED_FOR'}; + $self->{CALLED_FOR} = $id if defined $id; + return $self->{CALLED_FOR}; +} + +#-> sub CPAN::Distribution::safe_chdir ; +sub safe_chdir { + my($self,$todir) = @_; + # we die if we cannot chdir and we are debuggable + Carp::confess("safe_chdir called without todir argument") + unless defined $todir and length $todir; + if (chdir $todir) { + $self->debug(sprintf "changed directory to %s", CPAN::anycwd()) + if $CPAN::DEBUG; + } else { + my $cwd = CPAN::anycwd(); + $CPAN::Frontend->mydie(qq{Could not chdir from cwd[$cwd] }. + qq{to todir[$todir]: $!}); + } } #-> sub CPAN::Distribution::get ; @@ -3042,106 +3724,180 @@ sub get { EXCUSE: { my @e; exists $self->{'build_dir'} and push @e, - "Unwrapped into directory $self->{'build_dir'}"; + "Is already unwrapped into directory $self->{'build_dir'}"; $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e; } + my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible + + # + # Get the file on local disk + # + my($local_file); my($local_wanted) = - MM->catfile( - $CPAN::Config->{keep_source_where}, - "authors", - "id", - split("/",$self->{ID}) - ); + MM->catfile( + $CPAN::Config->{keep_source_where}, + "authors", + "id", + split("/",$self->id) + ); $self->debug("Doing localize") if $CPAN::DEBUG; - $local_file = - CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted) - or $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n"); - $self->{localfile} = $local_file; - my $builddir = $CPAN::META->{cachemgr}->dir; - $self->debug("doing chdir $builddir") if $CPAN::DEBUG; - chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!"); - my $packagedir; - + unless ($local_file = + CPAN::FTP->localize("authors/id/$self->{ID}", + $local_wanted)) { + my $note = ""; + if ($CPAN::Index::DATE_OF_02) { + $note = "Note: Current database in memory was generated ". + "on $CPAN::Index::DATE_OF_02\n"; + } + $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note"); + } $self->debug("local_file[$local_file]") if $CPAN::DEBUG; - if ($CPAN::META->has_inst('MD5')) { + $self->{localfile} = $local_file; + return if $CPAN::Signal; + + # + # Check integrity + # + if ($CPAN::META->has_inst("MD5")) { $self->debug("MD5 is installed, verifying"); $self->verifyMD5; } else { $self->debug("MD5 is NOT installed"); } + return if $CPAN::Signal; + + # + # Create a clean room and go there + # + $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok + my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok + $self->safe_chdir($builddir); $self->debug("Removing tmp") if $CPAN::DEBUG; File::Path::rmtree("tmp"); mkdir "tmp", 0755 or Carp::croak "Couldn't mkdir tmp: $!"; - chdir "tmp"; - $self->debug("Changed directory to tmp") if $CPAN::DEBUG; - if (! $local_file) { - Carp::croak "bad download, can't do anything :-(\n"; - } elsif ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)\z/i){ + if ($CPAN::Signal){ + $self->safe_chdir($sub_wd); + return; + } + $self->safe_chdir("tmp"); + + # + # Unpack the goods + # + if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)(?!\n)\Z/i){ + $self->{was_uncompressed}++ unless CPAN::Tarzip->gtest($local_file); $self->untar_me($local_file); - } elsif ( $local_file =~ /\.zip\z/i ) { + } elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) { $self->unzip_me($local_file); - } elsif ( $local_file =~ /\.pm\.(gz|Z)\z/) { + } elsif ( $local_file =~ /\.pm\.(gz|Z)(?!\n)\Z/) { + $self->{was_uncompressed}++ unless CPAN::Tarzip->gtest($local_file); $self->pm2dir_me($local_file); } else { $self->{archived} = "NO"; + $self->safe_chdir($sub_wd); + return; } - chdir File::Spec->updir; - if ($self->{archived} ne 'NO') { - chdir File::Spec->catdir(File::Spec->curdir, "tmp"); - # Let's check if the package has its own directory. - my $dh = DirHandle->new(File::Spec->curdir) - or Carp::croak("Couldn't opendir .: $!"); - my @readdir = grep $_ !~ /^\.\.?\z/s, $dh->read; ### MAC?? - $dh->close; - my ($distdir,$packagedir); - if (@readdir == 1 && -d $readdir[0]) { - $distdir = $readdir[0]; - $packagedir = MM->catdir($builddir,$distdir); - -d $packagedir and $CPAN::Frontend->myprint("Removing previously used $packagedir\n"); - File::Path::rmtree($packagedir); - rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!"); - } else { - my $pragmatic_dir = $self->{'CPAN_USERID'} . '000'; - $pragmatic_dir =~ s/\W_//g; - $pragmatic_dir++ while -d "../$pragmatic_dir"; - $packagedir = MM->catdir($builddir,$pragmatic_dir); - File::Path::mkpath($packagedir); - my($f); - for $f (@readdir) { # is already without "." and ".." - my $to = MM->catdir($packagedir,$f); - rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!"); - } - } - $self->{'build_dir'} = $packagedir; - chdir File::Spec->updir; - $self->debug("Changed directory to .. (self is $self [".$self->as_string."])") - if $CPAN::DEBUG; - File::Path::rmtree("tmp"); - if ($CPAN::Config->{keep_source_where} =~ /^no/i ){ - $CPAN::Frontend->myprint("Going to unlink $local_file\n"); - unlink $local_file or Carp::carp "Couldn't unlink $local_file"; - } - my($makefilepl) = MM->catfile($packagedir,"Makefile.PL"); - unless (-f $makefilepl) { - my($configure) = MM->catfile($packagedir,"Configure"); - if (-f $configure) { - # do we have anything to do? - $self->{'configure'} = $configure; - } elsif (-f MM->catfile($packagedir,"Makefile")) { - $CPAN::Frontend->myprint(qq{ + # we are still in the tmp directory! + # Let's check if the package has its own directory. + my $dh = DirHandle->new(File::Spec->curdir) + or Carp::croak("Couldn't opendir .: $!"); + my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC?? + $dh->close; + my ($distdir,$packagedir); + if (@readdir == 1 && -d $readdir[0]) { + $distdir = $readdir[0]; + $packagedir = MM->catdir($builddir,$distdir); + $self->debug("packagedir[$packagedir]builddir[$builddir]distdir[$distdir]") + if $CPAN::DEBUG; + -d $packagedir and $CPAN::Frontend->myprint("Removing previously used ". + "$packagedir\n"); + File::Path::rmtree($packagedir); + rename($distdir,$packagedir) or + Carp::confess("Couldn't rename $distdir to $packagedir: $!"); + $self->debug(sprintf("renamed distdir[%s] to packagedir[%s] -e[%s]-d[%s]", + $distdir, + $packagedir, + -e $packagedir, + -d $packagedir, + )) if $CPAN::DEBUG; + } else { + my $userid = $self->cpan_userid; + unless ($userid) { + CPAN->debug("no userid? self[$self]"); + $userid = "anon"; + } + my $pragmatic_dir = $userid . '000'; + $pragmatic_dir =~ s/\W_//g; + $pragmatic_dir++ while -d "../$pragmatic_dir"; + $packagedir = MM->catdir($builddir,$pragmatic_dir); + $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG; + File::Path::mkpath($packagedir); + my($f); + for $f (@readdir) { # is already without "." and ".." + my $to = MM->catdir($packagedir,$f); + rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!"); + } + } + if ($CPAN::Signal){ + $self->safe_chdir($sub_wd); + return; + } + + $self->{'build_dir'} = $packagedir; + $self->safe_chdir(File::Spec->updir); + File::Path::rmtree("tmp"); + + my($mpl) = MM->catfile($packagedir,"Makefile.PL"); + my($mpl_exists) = -f $mpl; + unless ($mpl_exists) { + # NFS has been reported to have racing problems after the + # renaming of a directory in some environments. + # This trick helps. + sleep 1; + my $mpldh = DirHandle->new($packagedir) + or Carp::croak("Couldn't opendir $packagedir: $!"); + $mpl_exists = grep /^Makefile\.PL$/, $mpldh->read; + $mpldh->close; + } + unless ($mpl_exists) { + $self->debug(sprintf("makefilepl[%s]anycwd[%s]", + $mpl, + CPAN::anycwd(), + )) if $CPAN::DEBUG; + my($configure) = MM->catfile($packagedir,"Configure"); + if (-f $configure) { + # do we have anything to do? + $self->{'configure'} = $configure; + } elsif (-f MM->catfile($packagedir,"Makefile")) { + $CPAN::Frontend->myprint(qq{ Package comes with a Makefile and without a Makefile.PL. We\'ll try to build it with that Makefile then. }); - $self->{writemakefile} = "YES"; - sleep 2; - } else { - my $fh = FileHandle->new(">$makefilepl") - or Carp::croak("Could not open >$makefilepl"); - my $cf = $self->called_for || "unknown"; - $fh->print( + $self->{writemakefile} = "YES"; + sleep 2; + } else { + my $cf = $self->called_for || "unknown"; + if ($cf =~ m|/|) { + $cf =~ s|.*/||; + $cf =~ s|\W.*||; + } + $cf =~ s|[/\\:]||g; # risk of filesystem damage + $cf = "unknown" unless length($cf); + $CPAN::Frontend->myprint(qq{Package seems to come without Makefile.PL. + (The test -f "$mpl" returned false.) + Writing one on our own (setting NAME to $cf)\a\n}); + $self->{had_no_makefile_pl}++; + sleep 3; + + # Writing our own Makefile.PL + + my $fh = FileHandle->new; + $fh->open(">$mpl") + or Carp::croak("Could not open >$mpl: $!"); + $fh->print( qq{# This Makefile.PL has been autogenerated by the module CPAN.pm # because there was no Makefile.PL supplied. # Autogenerated on: }.scalar localtime().qq{ @@ -3150,14 +3906,14 @@ use ExtUtils::MakeMaker; WriteMakefile(NAME => q[$cf]); }); - $CPAN::Frontend->myprint(qq{Package comes without Makefile.PL. - Writing one on our own (calling it $cf)\n}); - } - } + $fh->close; + } } + return $self; } +# CPAN::Distribution::untar_me ; sub untar_me { my($self,$local_file) = @_; $self->{archived} = "tar"; @@ -3168,22 +3924,23 @@ sub untar_me { } } +# CPAN::Distribution::unzip_me ; sub unzip_me { my($self,$local_file) = @_; $self->{archived} = "zip"; - my $system = "$CPAN::Config->{unzip} $local_file"; - if (system($system) == 0) { + if (CPAN::Tarzip->unzip($local_file)) { $self->{unwrapped} = "YES"; } else { $self->{unwrapped} = "NO"; } + return; } sub pm2dir_me { my($self,$local_file) = @_; $self->{archived} = "pm"; my $to = File::Basename::basename($local_file); - $to =~ s/\.(gz|Z)\z//; + $to =~ s/\.(gz|Z)(?!\n)\Z//; if (CPAN::Tarzip->gunzip($local_file,$to)) { $self->{unwrapped} = "YES"; } else { @@ -3195,7 +3952,7 @@ sub pm2dir_me { sub new { my($class,%att) = @_; - $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); + # $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); my $this = { %att }; return bless $this, $class; @@ -3222,18 +3979,25 @@ Please define it with "o conf shell " return; } my $dist = $self->id; - my $dir = $self->dir or $self->get; - $dir = $self->dir; - my $getcwd; - $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; - my $pwd = CPAN->$getcwd(); - chdir($dir); + my $dir; + unless ($dir = $self->dir) { + $self->get; + } + unless ($dir ||= $self->dir) { + $CPAN::Frontend->mywarn(qq{ +Could not determine which directory to use for looking at $dist. +}); + return; + } + my $pwd = CPAN::anycwd(); + $self->safe_chdir($dir); $CPAN::Frontend->myprint(qq{Working directory is $dir\n}); system($CPAN::Config->{'shell'}) == 0 or $CPAN::Frontend->mydie("Subprocess shell error"); - chdir($pwd); + $self->safe_chdir($pwd); } +# CPAN::Distribution::cvs_import ; sub cvs_import { my($self) = @_; $self->get; @@ -3243,10 +4007,10 @@ sub cvs_import { my $module = $CPAN::META->instance('CPAN::Module', $package); my $version = $module->cpan_version; - my $userid = $self->{CPAN_USERID}; + my $userid = $self->cpan_userid; my $cvs_dir = (split '/', $dir)[-1]; - $cvs_dir =~ s/-\d+[^-]+\z//; + $cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//; my $cvs_root = $CPAN::Config->{cvsroot} || $ENV{CVSROOT}; my $cvs_site_perl = @@ -3259,17 +4023,15 @@ sub cvs_import { my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log, "$cvs_dir", $userid, "v$version"); - my $getcwd; - $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; - my $pwd = CPAN->$getcwd(); - chdir($dir); + my $pwd = CPAN::anycwd(); + chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!}); $CPAN::Frontend->myprint(qq{Working directory is $dir\n}); $CPAN::Frontend->myprint(qq{@cmd\n}); - system(@cmd) == 0 or + system(@cmd) == 0 or $CPAN::Frontend->mydie("cvs import failed"); - chdir($pwd); + chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!}); } #-> sub CPAN::Distribution::readme ; @@ -3322,7 +4084,7 @@ sub verifyMD5 { $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e; } my($lc_want,$lc_file,@local,$basename); - @local = split("/",$self->{ID}); + @local = split("/",$self->id); pop @local; push @local, "CHECKSUMS"; $lc_want = @@ -3339,11 +4101,12 @@ sub verifyMD5 { $lc_file = CPAN::FTP->localize("authors/id/@local", $lc_want,1); unless ($lc_file) { + $CPAN::Frontend->myprint("Trying $lc_want.gz\n"); $local[-1] .= ".gz"; $lc_file = CPAN::FTP->localize("authors/id/@local", "$lc_want.gz",1); if ($lc_file) { - $lc_file =~ s/\.gz\z//; + $lc_file =~ s/\.gz(?!\n)\Z//; CPAN::Tarzip->gunzip("$lc_file.gz",$lc_file); } else { return; @@ -3401,33 +4164,42 @@ sub MD5_check_file { $CPAN::Frontend->myprint("Checksum for $file ok\n"); return $self->{MD5_STATUS} = "OK"; } else { - $CPAN::Frontend->myprint(qq{Checksum mismatch for }. + $CPAN::Frontend->myprint(qq{\nChecksum mismatch for }. qq{distribution file. }. qq{Please investigate.\n\n}. $self->as_string, $CPAN::META->instance( 'CPAN::Author', - $self->{CPAN_USERID} + $self->cpan_userid )->as_string); - my $wrap = qq{I\'d recommend removing $file. It seems to -be a bogus file. Maybe you have configured your \`urllist\' with a -bad URL. Please check this array with \`o conf urllist\', and + + my $wrap = qq{I\'d recommend removing $file. Its MD5 +checksum is incorrect. Maybe you have configured your 'urllist' with +a bad URL. Please check this array with 'o conf urllist', and retry.}; - $CPAN::Frontend->myprint(Text::Wrap::wrap("","",$wrap)); - $CPAN::Frontend->myprint("\n\n"); - sleep 3; - return; + + $CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap)); + + # former versions just returned here but this seems a + # serious threat that deserves a die + + # $CPAN::Frontend->myprint("\n\n"); + # sleep 3; + # return; } # close $fh if fileno($fh); } else { $self->{MD5_STATUS} ||= ""; if ($self->{MD5_STATUS} eq "NIL") { - $CPAN::Frontend->myprint(qq{ -No md5 checksum for $basename in local $chk_file. -Removing $chk_file + $CPAN::Frontend->mywarn(qq{ +Warning: No md5 checksum for $basename in $chk_file. + +The cause for this may be that the file is very new and the checksum +has not yet been calculated, but it may also be that something is +going awry right now. }); - unlink $chk_file or $CPAN::Frontend->myprint("Could not unlink: $!"); - sleep 1; + my $answer = ExtUtils::MakeMaker::prompt("Proceed?", "yes"); + $answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted."); } $self->{MD5_STATUS} = "NIL"; return; @@ -3449,36 +4221,65 @@ sub eq_MD5 { } #-> sub CPAN::Distribution::force ; + +# Both modules and distributions know if "force" is in effect by +# autoinspection, not by inspecting a global variable. One of the +# reason why this was chosen to work that way was the treatment of +# dependencies. They should not autpomatically inherit the force +# status. But this has the downside that ^C and die() will return to +# the prompt but will not be able to reset the force_update +# attributes. We try to correct for it currently in the read_metadata +# routine, and immediately before we check for a Signal. I hope this +# works out in one of v1.57_53ff + sub force { - my($self) = @_; - $self->{'force_update'}++; + my($self, $method) = @_; for my $att (qw( MD5_STATUS archived build_dir localfile make install unwrapped writemakefile )) { delete $self->{$att}; } + if ($method && $method eq "install") { + $self->{"force_update"}++; # name should probably have been force_install + } } +#-> sub CPAN::Distribution::unforce ; +sub unforce { + my($self) = @_; + delete $self->{'force_update'}; +} + +#-> sub CPAN::Distribution::isa_perl ; sub isa_perl { my($self) = @_; my $file = File::Basename::basename($self->id); - return unless $file =~ m{ ^ perl - (5) - ([._-]) - (\d{3}(_[0-4][0-9])?) - \.tar[._-]gz - \z - }xs; - "$1.$3"; + if ($file =~ m{ ^ perl + -? + (5) + ([._-]) + ( + \d{3}(_[0-4][0-9])? + | + \d*[24680]\.\d+ + ) + \.tar[._-]gz + (?!\n)\Z + }xs){ + return "$1.$3"; + } elsif ($self->cpan_comment + && + $self->cpan_comment =~ /isa_perl\(.+?\)/){ + return $1; + } } #-> sub CPAN::Distribution::perl ; sub perl { my($self) = @_; my($perl) = MM->file_name_is_absolute($^X) ? $^X : ""; - my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; - my $pwd = CPAN->$getcwd(); + my $pwd = CPAN::anycwd(); my $candidate = MM->catfile($pwd,$^X); $perl ||= $candidate if MM->maybe_command($candidate); unless ($perl) { @@ -3505,9 +4306,11 @@ sub make { # Emergency brake if they said install Pippi and get newest perl if ($self->isa_perl) { if ( - $self->called_for ne $self->id && ! $self->{'force_update'} + $self->called_for ne $self->id && + ! $self->{force_update} ) { - $CPAN::Frontend->mydie(sprintf qq{ + # if we die here, we break bundles + $CPAN::Frontend->mywarn(sprintf qq{ The most recent version "%s" of the module "%s" comes with the current version of perl (%s). I\'ll build that only if you ask for something like @@ -3523,6 +4326,7 @@ or $self->isa_perl, $self->called_for, $self->id); + sleep 5; return; } } $self->get; @@ -3539,7 +4343,10 @@ or $1 || "Had some problem writing Makefile"; defined $self->{'make'} and push @e, - "Has already been processed within this session"; + "Has already been processed within this session"; + + exists $self->{later} and length($self->{later}) and + push @e, $self->{later}; $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e; } @@ -3606,6 +4413,7 @@ or } if (-f "Makefile") { $self->{writemakefile} = "YES"; + delete $self->{make_clean}; # if cleaned before, enable next } else { $self->{writemakefile} = qq{NO Makefile.PL refused to write a Makefile.}; @@ -3615,32 +4423,12 @@ or # $self->{writemakefile} .= <$fh>; } } - return if $CPAN::Signal; - if (my @prereq = $self->needs_prereq){ - my $id = $self->id; - $CPAN::Frontend->myprint("---- Dependencies detected ". - "during [$id] -----\n"); - - for my $p (@prereq) { - $CPAN::Frontend->myprint(" $p\n"); - } - my $follow = 0; - if ($CPAN::Config->{prerequisites_policy} eq "follow") { - $follow = 1; - } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") { - require ExtUtils::MakeMaker; - my $answer = ExtUtils::MakeMaker::prompt( -"Shall I follow them and prepend them to the queue -of modules we are processing right now?", "yes"); - $follow = $answer =~ /^\s*y/i; - } else { - local($") = ", "; - $CPAN::Frontend->myprint(" Ignoring dependencies on modules @prereq\n"); - } - if ($follow) { - CPAN::Queue->jumpqueue(@prereq,$id); # requeue yourself - return; - } + if ($CPAN::Signal){ + delete $self->{force_update}; + return; + } + if (my @prereq = $self->unsat_prereq){ + return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner } $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg}; if (system($system) == 0) { @@ -3653,60 +4441,159 @@ of modules we are processing right now?", "yes"); } } -#-> sub CPAN::Distribution::needs_prereq ; -sub needs_prereq { - my($self) = @_; - return unless -f "Makefile"; # we cannot say much - my $fh = FileHandle->new("mydie("Couldn't open Makefile: $!"); - local($/) = "\n"; +sub follow_prereqs { + my($self) = shift; + my(@prereq) = @_; + my $id = $self->id; + $CPAN::Frontend->myprint("---- Unsatisfied dependencies detected ". + "during [$id] -----\n"); - my(@p,@need); - while (<$fh>) { - last if /MakeMaker post_initialize section/; - my($p) = m{^[\#] + for my $p (@prereq) { + $CPAN::Frontend->myprint(" $p\n"); + } + my $follow = 0; + if ($CPAN::Config->{prerequisites_policy} eq "follow") { + $follow = 1; + } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") { + require ExtUtils::MakeMaker; + my $answer = ExtUtils::MakeMaker::prompt( +"Shall I follow them and prepend them to the queue +of modules we are processing right now?", "yes"); + $follow = $answer =~ /^\s*y/i; + } else { + local($") = ", "; + $CPAN::Frontend-> + myprint(" Ignoring dependencies on modules @prereq\n"); + } + if ($follow) { + # color them as dirty + for my $p (@prereq) { + CPAN::Shell->expandany($p)->color_cmd_tmps(0,1); + } + CPAN::Queue->jumpqueue(@prereq,$id); # queue them and requeue yourself + $self->{later} = "Delayed until after prerequisites"; + return 1; # signal success to the queuerunner + } +} + +#-> sub CPAN::Distribution::unsat_prereq ; +sub unsat_prereq { + my($self) = @_; + my $prereq_pm = $self->prereq_pm or return; + my(@need); + NEED: while (my($need_module, $need_version) = each %$prereq_pm) { + my $nmo = $CPAN::META->instance("CPAN::Module",$need_module); + # we were too demanding: + next if $nmo->uptodate; + + # if they have not specified a version, we accept any installed one + if (not defined $need_version or + $need_version == 0 or + $need_version eq "undef") { + next if defined $nmo->inst_file; + } + + # We only want to install prereqs if either they're not installed + # or if the installed version is too old. We cannot omit this + # check, because if 'force' is in effect, nobody else will check. + { + local($^W) = 0; + if ( + defined $nmo->inst_file && + ! CPAN::Version->vgt($need_version, $nmo->inst_version) + ){ + CPAN->debug(sprintf "id[%s]inst_file[%s]inst_version[%s]need_version[%s]", + $nmo->id, + $nmo->inst_file, + $nmo->inst_version, + CPAN::Version->readable($need_version) + ); + next NEED; + } + } + + if ($self->{sponsored_mods}{$need_module}++){ + # We have already sponsored it and for some reason it's still + # not available. So we do nothing. Or what should we do? + # if we push it again, we have a potential infinite loop + next; + } + push @need, $need_module; + } + @need; +} + +#-> sub CPAN::Distribution::prereq_pm ; +sub prereq_pm { + my($self) = @_; + return $self->{prereq_pm} if + exists $self->{prereq_pm_detected} && $self->{prereq_pm_detected}; + return unless $self->{writemakefile}; # no need to have succeeded + # but we must have run it + my $build_dir = $self->{build_dir} or die "Panic: no build_dir?"; + my $makefile = File::Spec->catfile($build_dir,"Makefile"); + my(%p) = (); + my $fh; + if (-f $makefile + and + $fh = FileHandle->new("<$makefile\0")) { + + local($/) = "\n"; + + # A.Speer @p -> %p, where %p is $p{Module::Name}=Required_Version + while (<$fh>) { + last if /MakeMaker post_initialize section/; + my($p) = m{^[\#] \s+PREREQ_PM\s+=>\s+(.+) }x; - next unless $p; - # warn "Found prereq expr[$p]"; + next unless $p; + # warn "Found prereq expr[$p]"; - while ( $p =~ m/(?:\s)([\w\:]+)=>q\[.*?\],?/g ){ - push @p, $1; - } - last; + # Regexp modified by A.Speer to remember actual version of file + # PREREQ_PM hash key wants, then add to + while ( $p =~ m/(?:\s)([\w\:]+)=>q\[(.*?)\],?/g ){ + # In case a prereq is mentioned twice, complain. + if ( defined $p{$1} ) { + warn "Warning: PREREQ_PM mentions $1 more than once, last mention wins"; + } + $p{$1} = $2; + } + last; + } } - for my $p (@p) { - my $mo = $CPAN::META->instance("CPAN::Module",$p); - next if $mo->uptodate; - # it's not needed, so don't push it. We cannot omit this step, because - # if 'force' is in effect, nobody else will check. - if ($self->{have_sponsored}{$p}++){ - # We have already sponsored it and for some reason it's still - # not available. So we do nothing. Or what should we do? - # if we push it again, we have a potential infinite loop - next; - } - push @need, $p; - } - return @need; + $self->{prereq_pm_detected}++; + return $self->{prereq_pm} = \%p; } #-> sub CPAN::Distribution::test ; sub test { my($self) = @_; $self->make; - return if $CPAN::Signal; + if ($CPAN::Signal){ + delete $self->{force_update}; + return; + } $CPAN::Frontend->myprint("Running make test\n"); + if (my @prereq = $self->unsat_prereq){ + return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner + } EXCUSE: { my @e; - exists $self->{'make'} or push @e, + exists $self->{make} or exists $self->{later} or push @e, "Make had some problems, maybe interrupted? Won't test"; exists $self->{'make'} and $self->{'make'} eq 'NO' and - push @e, "Oops, make had returned bad status"; + push @e, "Can't test without successful make"; + + exists $self->{build_dir} or push @e, "Has no own directory"; + $self->{badtestcnt} ||= 0; + $self->{badtestcnt} > 0 and + push @e, "Won't repeat unsuccessful test during this command"; + + exists $self->{later} and length($self->{later}) and + push @e, $self->{later}; - exists $self->{'build_dir'} or push @e, "Has no own directory"; $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e; } chdir $self->{'build_dir'} or @@ -3722,9 +4609,10 @@ sub test { my $system = join " ", $CPAN::Config->{'make'}, "test"; if (system($system) == 0) { $CPAN::Frontend->myprint(" $system -- OK\n"); - $self->{'make_test'} = "YES"; + $self->{make_test} = "YES"; } else { - $self->{'make_test'} = "NO"; + $self->{make_test} = "NO"; + $self->{badtestcnt}++; $CPAN::Frontend->myprint(" $system -- NOT OK\n"); } } @@ -3735,7 +4623,9 @@ sub clean { $CPAN::Frontend->myprint("Running make clean\n"); EXCUSE: { my @e; - exists $self->{'build_dir'} or push @e, "Has no own directory"; + exists $self->{make_clean} and $self->{make_clean} eq "YES" and + push @e, "make clean already called once"; + exists $self->{build_dir} or push @e, "Has no own directory"; $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e; } chdir $self->{'build_dir'} or @@ -3749,10 +4639,31 @@ sub clean { my $system = join " ", $CPAN::Config->{'make'}, "clean"; if (system($system) == 0) { - $CPAN::Frontend->myprint(" $system -- OK\n"); - $self->force; + $CPAN::Frontend->myprint(" $system -- OK\n"); + + # $self->force; + + # Jost Krieger pointed out that this "force" was wrong because + # it has the effect that the next "install" on this distribution + # will untar everything again. Instead we should bring the + # object's state back to where it is after untarring. + + delete $self->{force_update}; + delete $self->{install}; + delete $self->{writemakefile}; + delete $self->{make}; + delete $self->{make_test}; # no matter if yes or no, tests must be redone + $self->{make_clean} = "YES"; + } else { - # Hmmm, what to do if make clean failed? + # Hmmm, what to do if make clean failed? + + $CPAN::Frontend->myprint(qq{ $system -- NOT OK + +make clean did not succeed, marking directory as unusable for further work. +}); + $self->force("make"); # so that this directory won't be used again + } } @@ -3760,18 +4671,21 @@ sub clean { sub install { my($self) = @_; $self->test; - return if $CPAN::Signal; + if ($CPAN::Signal){ + delete $self->{force_update}; + return; + } $CPAN::Frontend->myprint("Running make install\n"); EXCUSE: { my @e; - exists $self->{'build_dir'} or push @e, "Has no own directory"; + exists $self->{build_dir} or push @e, "Has no own directory"; - exists $self->{'make'} or push @e, + exists $self->{make} or exists $self->{later} or push @e, "Make had some problems, maybe interrupted? Won't install"; exists $self->{'make'} and $self->{'make'} eq 'NO' and - push @e, "Oops, make had returned bad status"; + push @e, "make had returned bad status, install seems impossible"; push @e, "make test had returned bad status, ". "won't install without force" @@ -3783,6 +4697,9 @@ sub install { $self->{'install'} eq "YES" ? "Already done" : "Already tried without success"; + exists $self->{later} and length($self->{later}) and + push @e, $self->{later}; + $CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e; } chdir $self->{'build_dir'} or @@ -3816,6 +4733,7 @@ sub install { qq{to root to install the package\n}); } } + delete $self->{force_update}; } #-> sub CPAN::Distribution::dir ; @@ -3825,69 +4743,114 @@ sub dir { package CPAN::Bundle; +sub undelay { + my $self = shift; + delete $self->{later}; + for my $c ( $self->contains ) { + my $obj = CPAN::Shell->expandany($c) or next; + $obj->undelay; + } +} + +#-> sub CPAN::Bundle::color_cmd_tmps ; +sub color_cmd_tmps { + my($self) = shift; + my($depth) = shift || 0; + my($color) = shift || 0; + # a module needs to recurse to its cpan_file, a distribution needs + # to recurse into its prereq_pms, a bundle needs to recurse into its modules + + return if exists $self->{incommandcolor} + && $self->{incommandcolor}==$color; + $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ". + "color_cmd_tmps depth[%s] self[%s] id[%s]", + $depth, + $self, + $self->id + )) if $depth>=100; + ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1; + + for my $c ( $self->contains ) { + my $obj = CPAN::Shell->expandany($c) or next; + CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG; + $obj->color_cmd_tmps($depth+1,$color); + } + if ($color==0) { + delete $self->{badtestcnt}; + } + $self->{incommandcolor} = $color; +} + #-> sub CPAN::Bundle::as_string ; sub as_string { my($self) = @_; $self->contains; + # following line must be "=", not "||=" because we have a moving target $self->{INST_VERSION} = $self->inst_version; return $self->SUPER::as_string; } #-> sub CPAN::Bundle::contains ; sub contains { - my($self) = @_; - my($parsefile) = $self->inst_file; - my($id) = $self->id; - $self->debug("parsefile[$parsefile]id[$id]") if $CPAN::DEBUG; - unless ($parsefile) { - # Try to get at it in the cpan directory - $self->debug("no parsefile") if $CPAN::DEBUG; - Carp::confess "I don't know a $id" unless $self->{CPAN_FILE}; - my $dist = $CPAN::META->instance('CPAN::Distribution', - $self->{CPAN_FILE}); - $dist->get; - $self->debug($dist->as_string) if $CPAN::DEBUG; - my($todir) = $CPAN::Config->{'cpan_home'}; - my(@me,$from,$to,$me); - @me = split /::/, $self->id; - $me[-1] .= ".pm"; - $me = MM->catfile(@me); - $from = $self->find_bundle_file($dist->{'build_dir'},$me); - $to = MM->catfile($todir,$me); - File::Path::mkpath(File::Basename::dirname($to)); - File::Copy::copy($from, $to) - or Carp::confess("Couldn't copy $from to $to: $!"); - $parsefile = $to; - } - my @result; - my $fh = FileHandle->new; - local $/ = "\n"; - open($fh,$parsefile) or die "Could not open '$parsefile': $!"; - my $in_cont = 0; - $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG; - while (<$fh>) { - $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 : - m/^=head1\s+CONTENTS/ ? 1 : $in_cont; - next unless $in_cont; - next if /^=/; - s/\#.*//; - next if /^\s+$/; - chomp; - push @result, (split " ", $_, 2)[0]; - } - close $fh; - delete $self->{STATUS}; - $self->{CONTAINS} = join ", ", @result; - $self->debug("CONTAINS[@result]") if $CPAN::DEBUG; - unless (@result) { - $CPAN::Frontend->mywarn(qq{ -The bundle file "$parsefile" may be a broken + my($self) = @_; + my($inst_file) = $self->inst_file || ""; + my($id) = $self->id; + $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG; + unless ($inst_file) { + # Try to get at it in the cpan directory + $self->debug("no inst_file") if $CPAN::DEBUG; + my $cpan_file; + $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless + $cpan_file = $self->cpan_file; + if ($cpan_file eq "N/A") { + $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN. + Maybe stale symlink? Maybe removed during session? Giving up.\n"); + } + my $dist = $CPAN::META->instance('CPAN::Distribution', + $self->cpan_file); + $dist->get; + $self->debug($dist->as_string) if $CPAN::DEBUG; + my($todir) = $CPAN::Config->{'cpan_home'}; + my(@me,$from,$to,$me); + @me = split /::/, $self->id; + $me[-1] .= ".pm"; + $me = MM->catfile(@me); + $from = $self->find_bundle_file($dist->{'build_dir'},$me); + $to = MM->catfile($todir,$me); + File::Path::mkpath(File::Basename::dirname($to)); + File::Copy::copy($from, $to) + or Carp::confess("Couldn't copy $from to $to: $!"); + $inst_file = $to; + } + my @result; + my $fh = FileHandle->new; + local $/ = "\n"; + open($fh,$inst_file) or die "Could not open '$inst_file': $!"; + my $in_cont = 0; + $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG; + while (<$fh>) { + $in_cont = m/^=(?!head1\s+CONTENTS)/ ? 0 : + m/^=head1\s+CONTENTS/ ? 1 : $in_cont; + next unless $in_cont; + next if /^=/; + s/\#.*//; + next if /^\s+$/; + chomp; + push @result, (split " ", $_, 2)[0]; + } + close $fh; + delete $self->{STATUS}; + $self->{CONTAINS} = \@result; + $self->debug("CONTAINS[@result]") if $CPAN::DEBUG; + unless (@result) { + $CPAN::Frontend->mywarn(qq{ +The bundle file "$inst_file" may be a broken bundlefile. It seems not to contain any bundle definition. Please check the file and if it is bogus, please delete it. Sorry for the inconvenience. }); - } - @result; + } + @result; } #-> sub CPAN::Bundle::find_bundle_file @@ -3900,11 +4863,10 @@ sub find_bundle_file { my $manifest = MM->catfile($where,"MANIFEST"); unless (-f $manifest) { require ExtUtils::Manifest; - my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd'; - my $cwd = CPAN->$getcwd(); - chdir $where; + my $cwd = CPAN::anycwd(); + chdir $where or $CPAN::Frontend->mydie(qq{Could not chdir to "$where": $!}); ExtUtils::Manifest::mkmanifest(); - chdir $cwd; + chdir $cwd or $CPAN::Frontend->mydie(qq{Could not chdir to "$cwd": $!}); } my $fh = FileHandle->new($manifest) or Carp::croak("Couldn't open $manifest: $!"); @@ -3936,22 +4898,37 @@ sub find_bundle_file { Carp::croak("Couldn't find a Bundle file in $where"); } +# needs to work quite differently from Module::inst_file because of +# cpan_home/Bundle/ directory and the possibility that we have +# shadowing effect. As it makes no sense to take the first in @INC for +# Bundles, we parse them all for $VERSION and take the newest. + #-> sub CPAN::Bundle::inst_file ; sub inst_file { my($self) = @_; - my($me,$inst_file); - ($me = $self->id) =~ s/.*://; -## my(@me,$inst_file); -## @me = split /::/, $self->id; -## $me[-1] .= ".pm"; - $inst_file = MM->catfile($CPAN::Config->{'cpan_home'}, - "Bundle", "$me.pm"); -## "Bundle", @me); - return $self->{'INST_FILE'} = $inst_file if -f $inst_file; -# $inst_file = - $self->SUPER::inst_file; -# return $self->{'INST_FILE'} = $inst_file if -f $inst_file; -# return $self->{'INST_FILE'}; # even if undefined? + my($inst_file); + my(@me); + @me = split /::/, $self->id; + $me[-1] .= ".pm"; + my($incdir,$bestv); + foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) { + my $bfile = MM->catfile($incdir, @me); + CPAN->debug("bfile[$bfile]") if $CPAN::DEBUG; + next unless -f $bfile; + my $foundv = MM->parse_version($bfile); + if (!$bestv || CPAN::Version->vgt($foundv,$bestv)) { + $self->{INST_FILE} = $bfile; + $self->{INST_VERSION} = $bestv = $foundv; + } + } + $self->{INST_FILE}; +} + +#-> sub CPAN::Bundle::inst_version ; +sub inst_version { + my($self) = @_; + $self->inst_file; # finds INST_VERSION as side effect + $self->{INST_VERSION}; } #-> sub CPAN::Bundle::rematein ; @@ -3960,7 +4937,7 @@ sub rematein { $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG; my($id) = $self->id; Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n" - unless $self->inst_file || $self->{CPAN_FILE}; + unless $self->inst_file || $self->cpan_file; my($s,%fail); for $s ($self->contains) { my($type) = $s =~ m|/| ? 'CPAN::Distribution' : @@ -3973,14 +4950,36 @@ explicitly a file $s. sleep 3; } # possibly noisy action: + $self->debug("type[$type] s[$s]") if $CPAN::DEBUG; my $obj = $CPAN::META->instance($type,$s); $obj->$meth(); - my $success = $obj->can("uptodate") ? $obj->uptodate : 0; - $success ||= $obj->{'install'} && $obj->{'install'} eq "YES"; - $fail{$s} = 1 unless $success; + if ($obj->isa(CPAN::Bundle) + && + exists $obj->{install_failed} + && + ref($obj->{install_failed}) eq "HASH" + ) { + for (keys %{$obj->{install_failed}}) { + $self->{install_failed}{$_} = undef; # propagate faiure up + # to me in a + # recursive call + $fail{$s} = 1; # the bundle itself may have succeeded but + # not all children + } + } else { + my $success; + $success = $obj->can("uptodate") ? $obj->uptodate : 0; + $success ||= $obj->{'install'} && $obj->{'install'} eq "YES"; + if ($success) { + delete $self->{install_failed}{$s}; + } else { + $fail{$s} = 1; + } + } } + # recap with less noise - if ( $meth eq "install") { + if ( $meth eq "install" ) { if (%fail) { require Text::Wrap; my $raw = sprintf(qq{Bundle summary: @@ -3990,9 +4989,21 @@ The following items in bundle %s had installation problems:}, $CPAN::Frontend->myprint(Text::Wrap::fill("","",$raw)); $CPAN::Frontend->myprint("\n"); my $paragraph = ""; + my %reported; for $s ($self->contains) { - $paragraph .= "$s " if $fail{$s}; + if ($fail{$s}){ + $paragraph .= "$s "; + $self->{install_failed}{$s} = undef; + $reported{$s} = undef; + } } + my $report_propagated; + for $s (sort keys %{$self->{install_failed}}) { + next if exists $reported{$s}; + $paragraph .= "and the following items had problems +during recursive bundle calls: " unless $report_propagated++; + $paragraph .= "$s "; + } $CPAN::Frontend->myprint(Text::Wrap::fill(" "," ",$paragraph)); $CPAN::Frontend->myprint("\n"); } else { @@ -4015,7 +5026,11 @@ sub get { shift->rematein('get',@_); } #-> sub CPAN::Bundle::make ; sub make { shift->rematein('make',@_); } #-> sub CPAN::Bundle::test ; -sub test { shift->rematein('test',@_); } +sub test { + my $self = shift; + $self->{badtestcnt} ||= 0; + $self->rematein('test',@_); +} #-> sub CPAN::Bundle::install ; sub install { my $self = shift; @@ -4024,6 +5039,18 @@ sub install { #-> sub CPAN::Bundle::clean ; sub clean { shift->rematein('clean',@_); } +#-> sub CPAN::Bundle::uptodate ; +sub uptodate { + my($self) = @_; + return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def + my $c; + foreach $c ($self->contains) { + my $obj = CPAN::Shell->expandany($c); + return 0 unless $obj->uptodate; + } + return 1; +} + #-> sub CPAN::Bundle::readme ; sub readme { my($self) = @_; @@ -4035,13 +5062,72 @@ No File found for bundle } . $self->id . qq{\n}), return; package CPAN::Module; +# Accessors +# sub cpan_userid { shift->{RO}{CPAN_USERID} } +sub userid { + my $self = shift; + return unless exists $self->{RO}; # should never happen + return $self->{RO}{CPAN_USERID} || $self->{RO}{userid}; +} +sub description { shift->{RO}{description} } + +sub undelay { + my $self = shift; + delete $self->{later}; + if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) { + $dist->undelay; + } +} + +#-> sub CPAN::Module::color_cmd_tmps ; +sub color_cmd_tmps { + my($self) = shift; + my($depth) = shift || 0; + my($color) = shift || 0; + # a module needs to recurse to its cpan_file + + return if exists $self->{incommandcolor} + && $self->{incommandcolor}==$color; + $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: deep recursion in ". + "color_cmd_tmps depth[%s] self[%s] id[%s]", + $depth, + $self, + $self->id + )) if $depth>=100; + ##### warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1; + + if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) { + $dist->color_cmd_tmps($depth+1,$color); + } + if ($color==0) { + delete $self->{badtestcnt}; + } + $self->{incommandcolor} = $color; +} + #-> sub CPAN::Module::as_glimpse ; sub as_glimpse { my($self) = @_; my(@m); my $class = ref($self); $class =~ s/^CPAN:://; - push @m, sprintf("%-15s %-15s (%s)\n", $class, $self->{ID}, + my $color_on = ""; + my $color_off = ""; + if ( + $CPAN::Shell::COLOR_REGISTERED + && + $CPAN::META->has_inst("Term::ANSIColor") + && + $self->{RO}{description} + ) { + $color_on = Term::ANSIColor::color("green"); + $color_off = Term::ANSIColor::color("reset"); + } + push @m, sprintf("%-15s %s%-15s%s (%s)\n", + $class, + $color_on, + $self->id, + $color_off, $self->cpan_file); join "", @m; } @@ -4056,11 +5142,11 @@ sub as_string { local($^W) = 0; push @m, $class, " id = $self->{ID}\n"; my $sprintf = " %-12s %s\n"; - push @m, sprintf($sprintf, 'DESCRIPTION', $self->{description}) - if $self->{description}; + push @m, sprintf($sprintf, 'DESCRIPTION', $self->description) + if $self->description; my $sprintf2 = " %-12s %s (%s)\n"; my($userid); - if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){ + if ($userid = $self->cpan_userid || $self->userid){ my $author; if ($author = CPAN::Shell->expand('Author',$userid)) { my $email = ""; @@ -4076,10 +5162,10 @@ sub as_string { ); } } - push @m, sprintf($sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION}) - if $self->{CPAN_VERSION}; - push @m, sprintf($sprintf, 'CPAN_FILE', $self->{CPAN_FILE}) - if $self->{CPAN_FILE}; + push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version) + if $self->cpan_version; + push @m, sprintf($sprintf, 'CPAN_FILE', $self->cpan_file) + if $self->cpan_file; my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n"; my(%statd,%stats,%statl,%stati); @statd{qw,? i c a b R M S,} = qw,unknown idea @@ -4096,24 +5182,68 @@ sub as_string { push @m, sprintf( $sprintf3, 'DSLI_STATUS', - $self->{statd}, - $self->{stats}, - $self->{statl}, - $self->{stati}, - $statd{$self->{statd}}, - $stats{$self->{stats}}, - $statl{$self->{statl}}, - $stati{$self->{stati}} - ) if $self->{statd}; + $self->{RO}{statd}, + $self->{RO}{stats}, + $self->{RO}{statl}, + $self->{RO}{stati}, + $statd{$self->{RO}{statd}}, + $stats{$self->{RO}{stats}}, + $statl{$self->{RO}{statl}}, + $stati{$self->{RO}{stati}} + ) if $self->{RO}{statd}; my $local_file = $self->inst_file; - if ($local_file) { - $self->{MANPAGE} ||= $self->manpage_headline($local_file); + unless ($self->{MANPAGE}) { + if ($local_file) { + $self->{MANPAGE} = $self->manpage_headline($local_file); + } else { + # If we have already untarred it, we should look there + my $dist = $CPAN::META->instance('CPAN::Distribution', + $self->cpan_file); + # warn "dist[$dist]"; + # mff=manifest file; mfh=manifest handle + my($mff,$mfh); + if ( + $dist->{build_dir} + and + (-f ($mff = MM->catfile($dist->{build_dir}, "MANIFEST"))) + and + $mfh = FileHandle->new($mff) + ) { + CPAN->debug("mff[$mff]") if $CPAN::DEBUG; + my $lfre = $self->id; # local file RE + $lfre =~ s/::/./g; + $lfre .= "\\.pm\$"; + my($lfl); # local file file + local $/ = "\n"; + my(@mflines) = <$mfh>; + for (@mflines) { + s/^\s+//; + s/\s.*//s; + } + while (length($lfre)>5 and !$lfl) { + ($lfl) = grep /$lfre/, @mflines; + CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG; + $lfre =~ s/.+?\.//; + } + $lfl =~ s/\s.*//; # remove comments + $lfl =~ s/\s+//g; # chomp would maybe be too system-specific + my $lfl_abs = MM->catfile($dist->{build_dir},$lfl); + # warn "lfl_abs[$lfl_abs]"; + if (-f $lfl_abs) { + $self->{MANPAGE} = $self->manpage_headline($lfl_abs); + } + } + } } my($item); - for $item (qw/MANPAGE CONTAINS/) { + for $item (qw/MANPAGE/) { push @m, sprintf($sprintf, $item, $self->{$item}) if exists $self->{$item}; } + for $item (qw/CONTAINS/) { + push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}})) + if exists $self->{$item} && @{$self->{$item}}; + } push @m, sprintf($sprintf, 'INST_FILE', $local_file || "(not installed)"); push @m, sprintf($sprintf, 'INST_VERSION', @@ -4124,7 +5254,7 @@ sub as_string { sub manpage_headline { my($self,$local_file) = @_; my(@local_file) = $local_file; - $local_file =~ s/\.pm\z/.pod/; + $local_file =~ s/\.pm(?!\n)\Z/.pod/; push @local_file, $local_file; my(@result,$locf); for $locf (@local_file) { @@ -4149,44 +5279,49 @@ sub manpage_headline { } #-> sub CPAN::Module::cpan_file ; -sub cpan_file { +# Note: also inherited by CPAN::Bundle +sub cpan_file { my $self = shift; - CPAN->debug($self->id) if $CPAN::DEBUG; - unless (defined $self->{'CPAN_FILE'}) { + CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG; + unless (defined $self->{RO}{CPAN_FILE}) { CPAN::Index->reload; } - if (exists $self->{'CPAN_FILE'} && defined $self->{'CPAN_FILE'}){ - return $self->{'CPAN_FILE'}; - } elsif (exists $self->{'userid'} && defined $self->{'userid'}) { - my $fullname = $CPAN::META->instance(CPAN::Author, - $self->{'userid'})->fullname; - my $email = $CPAN::META->instance(CPAN::Author, - $self->{'userid'})->email; - unless (defined $fullname && defined $email) { - return "Contact Author $self->{userid} (Try ``a $self->{userid}'')"; - } - return "Contact Author $fullname <$email>"; + if (exists $self->{RO}{CPAN_FILE} && defined $self->{RO}{CPAN_FILE}){ + return $self->{RO}{CPAN_FILE}; } else { - return "N/A"; + my $userid = $self->userid; + if ( $userid ) { + if ($CPAN::META->exists("CPAN::Author",$userid)) { + my $author = $CPAN::META->instance("CPAN::Author", + $userid); + my $fullname = $author->fullname; + my $email = $author->email; + unless (defined $fullname && defined $email) { + return sprintf("Contact Author %s", + $userid, + ); + } + return "Contact Author $fullname <$email>"; + } else { + return "UserID $userid"; + } + } else { + return "N/A"; + } } } -*name = \&cpan_file; - #-> sub CPAN::Module::cpan_version ; sub cpan_version { my $self = shift; - $self->{'CPAN_VERSION'} = 'undef' - unless defined $self->{'CPAN_VERSION'}; # I believe this is - # always a bug in the - # index and should be - # reported as such, - # but usually I find - # out such an error - # and do not want to - # provoke too many - # bugreports - $self->{'CPAN_VERSION'}; + + $self->{RO}{CPAN_VERSION} = 'undef' + unless defined $self->{RO}{CPAN_VERSION}; + # I believe this is always a bug in the index and should be reported + # as such, but usually I find out such an error and do not want to + # provoke too many bugreports + + $self->{RO}{CPAN_VERSION}; } #-> sub CPAN::Module::force ; @@ -4198,7 +5333,9 @@ sub force { #-> sub CPAN::Module::rematein ; sub rematein { my($self,$meth) = @_; - $self->debug($self->id) if $CPAN::DEBUG; + $CPAN::Frontend->myprint(sprintf("Running %s for module %s\n", + $meth, + $self->id)); my $cpan_file = $self->cpan_file; if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/){ $CPAN::Frontend->mywarn(sprintf qq{ @@ -4206,7 +5343,7 @@ sub rematein { Either the module has not yet been uploaded to CPAN, or it is temporary unavailable. Please contact the author to find out - more about the status. Try ``i %s''. + more about the status. Try 'i %s'. }, $self->id, $self->id, @@ -4215,8 +5352,9 @@ sub rematein { } my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file); $pack->called_for($self->id); - $pack->force if exists $self->{'force_update'}; + $pack->force($meth) if exists $self->{'force_update'}; $pack->$meth(); + $pack->unforce if $pack->can("unforce") && exists $self->{'force_update'}; delete $self->{'force_update'}; } @@ -4229,9 +5367,16 @@ sub cvs_import { shift->rematein('cvs_import') } #-> sub CPAN::Module::get ; sub get { shift->rematein('get',@_); } #-> sub CPAN::Module::make ; -sub make { shift->rematein('make') } +sub make { + my $self = shift; + $self->rematein('make'); +} #-> sub CPAN::Module::test ; -sub test { shift->rematein('test') } +sub test { + my $self = shift; + $self->{badtestcnt} ||= 0; + $self->rematein('test',@_); +} #-> sub CPAN::Module::uptodate ; sub uptodate { my($self) = @_; @@ -4245,9 +5390,11 @@ sub uptodate { local($^W)=0; if ($inst_file && - $have >= $latest + ! CPAN::Version->vgt($latest, $have) ) { - return 1; + CPAN->debug("returning uptodate. inst_file[$inst_file] ". + "latest[$latest] have[$have]") if $CPAN::DEBUG; + return 1; } return; } @@ -4304,14 +5451,49 @@ sub inst_version { my($self) = @_; my $parsefile = $self->inst_file or return; local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38; - # warn "HERE"; - my $have = MM->parse_version($parsefile) || "undef"; + my $have; + + # there was a bug in 5.6.0 that let lots of unini warnings out of + # parse_version. Fixed shortly after 5.6.0 by PMQS. We can remove + # the following workaround after 5.6.1 is out. + local($SIG{__WARN__}) = sub { my $w = shift; + return if $w =~ /uninitialized/i; + warn $w; + }; + + $have = MM->parse_version($parsefile) || "undef"; + $have =~ s/^ //; # since the %vd hack these two lines here are needed + $have =~ s/ $//; # trailing whitespace happens all the time + + # My thoughts about why %vd processing should happen here + + # Alt1 maintain it as string with leading v: + # read index files do nothing + # compare it use utility for compare + # print it do nothing + + # Alt2 maintain it as what is is + # read index files convert + # compare it use utility because there's still a ">" vs "gt" issue + # print it use CPAN::Version for print + + # Seems cleaner to hold it in memory as a string starting with a "v" + + # If the author of this module made a mistake and wrote a quoted + # "v1.13" instead of v1.13, we simply leave it at that with the + # effect that *we* will treat it like a v-tring while the rest of + # perl won't. Seems sensible when we consider that any action we + # could take now would just add complexity. + + $have = CPAN::Version->readable($have); + $have =~ s/\s*//g; # stringify to float around floating point issues - $have; + $have; # no stringify needed, \s* above matches always } package CPAN::Tarzip; +# CPAN::Tarzip::gzip sub gzip { my($class,$read,$write) = @_; if ($CPAN::META->has_inst("Compress::Zlib")) { @@ -4326,10 +5508,12 @@ sub gzip { $fhw->close; return 1; } else { - system("$CPAN::Config->{'gzip'} -c $read > $write")==0; + system("$CPAN::Config->{gzip} -c $read > $write")==0; } } + +# CPAN::Tarzip::gunzip sub gunzip { my($class,$read,$write) = @_; if ($CPAN::META->has_inst("Compress::Zlib")) { @@ -4346,26 +5530,43 @@ sub gunzip { $fhw->close; return 1; } else { - system("$CPAN::Config->{'gzip'} -dc $read > $write")==0; + system("$CPAN::Config->{gzip} -dc $read > $write")==0; } } + +# CPAN::Tarzip::gtest sub gtest { my($class,$read) = @_; - if ($CPAN::META->has_inst("Compress::Zlib")) { - my($buffer); + # After I had reread the documentation in zlib.h, I discovered that + # uncompressed files do not lead to an gzerror (anymore?). + if ( $CPAN::META->has_inst("Compress::Zlib") ) { + my($buffer,$len); + $len = 0; my $gz = Compress::Zlib::gzopen($read, "rb") - or $CPAN::Frontend->mydie("Cannot open $read: $!\n"); - 1 while $gz->gzread($buffer) > 0 ; - $CPAN::Frontend->mydie("Error reading from $read: $!\n") - if $gz->gzerror != Compress::Zlib::Z_STREAM_END(); - $gz->gzclose() ; - return 1; + or $CPAN::Frontend->mydie(sprintf("Cannot gzopen %s: %s\n", + $read, + $Compress::Zlib::gzerrno)); + while ($gz->gzread($buffer) > 0 ){ + $len += length($buffer); + $buffer = ""; + } + my $err = $gz->gzerror; + my $success = ! $err || $err == Compress::Zlib::Z_STREAM_END(); + if ($len == -s $read){ + $success = 0; + CPAN->debug("hit an uncompressed file") if $CPAN::DEBUG; + } + $gz->gzclose(); + CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG; + return $success; } else { - return system("$CPAN::Config->{'gzip'} -dt $read")==0; + return system("$CPAN::Config->{gzip} -dt $read")==0; } } + +# CPAN::Tarzip::TIEHANDLE sub TIEHANDLE { my($class,$file) = @_; my $ret; @@ -4375,14 +5576,16 @@ sub TIEHANDLE { die "Could not gzopen $file"; $ret = bless {GZ => $gz}, $class; } else { - my $pipe = "$CPAN::Config->{'gzip'} --decompress --stdout $file |"; - my $fh = FileHandle->new($pipe) or die "Could pipe[$pipe]: $!"; + my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $file |"; + my $fh = FileHandle->new($pipe) or die "Could not pipe[$pipe]: $!"; binmode $fh; $ret = bless {FH => $fh}, $class; } $ret; } + +# CPAN::Tarzip::READLINE sub READLINE { my($self) = @_; if (exists $self->{GZ}) { @@ -4397,6 +5600,8 @@ sub READLINE { } } + +# CPAN::Tarzip::READ sub READ { my($self,$ref,$length,$offset) = @_; die "read with offset not implemented" if defined $offset; @@ -4410,60 +5615,40 @@ sub READ { } } + +# CPAN::Tarzip::DESTROY sub DESTROY { - my($self) = @_; - if (exists $self->{GZ}) { - my $gz = $self->{GZ}; - $gz->gzclose(); - } else { - my $fh = $self->{FH}; - $fh->close if defined $fh; - } - undef $self; + my($self) = @_; + if (exists $self->{GZ}) { + my $gz = $self->{GZ}; + $gz->gzclose() if defined $gz; # hard to say if it is allowed + # to be undef ever. AK, 2000-09 + } else { + my $fh = $self->{FH}; + $fh->close if defined $fh; + } + undef $self; } + +# CPAN::Tarzip::untar sub untar { my($class,$file) = @_; - # had to disable, because version 0.07 seems to be buggy - if (MM->maybe_command($CPAN::Config->{'gzip'}) - && - MM->maybe_command($CPAN::Config->{'tar'})) { - my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " . - "< $file | $CPAN::Config->{tar} xvf -"; - if (system($system) != 0) { - # people find the most curious tar binaries that cannot handle - # pipes - my $system = "$CPAN::Config->{'gzip'} --decompress $file"; - if (system($system)==0) { - $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n}); - } else { - $CPAN::Frontend->mydie( - qq{Couldn\'t uncompress $file\n} - ); - } - $file =~ s/\.gz\z//; - $system = "$CPAN::Config->{tar} xvf $file"; - $CPAN::Frontend->myprint(qq{Using Tar:$system:\n}); - if (system($system)==0) { - $CPAN::Frontend->myprint(qq{Untarred $file successfully\n}); - } else { - $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n}); - } - return 1; - } else { - return 1; - } - } elsif ($CPAN::META->has_inst("Archive::Tar") - && - $CPAN::META->has_inst("Compress::Zlib") ) { - my $tar = Archive::Tar->new($file,1); - $tar->extract($tar->list_files); # I'm pretty sure we have nothing - # that isn't compressed + my($prefer) = 0; - ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1) - if ($^O eq 'MacOS'); - - return 1; + if (0) { # makes changing order easier + } elsif ($BUGHUNTING){ + $prefer=2; + } elsif (MM->maybe_command($CPAN::Config->{gzip}) + && + MM->maybe_command($CPAN::Config->{'tar'})) { + # should be default until Archive::Tar is fixed + $prefer = 1; + } elsif ( + $CPAN::META->has_inst("Archive::Tar") + && + $CPAN::META->has_inst("Compress::Zlib") ) { + $prefer = 2; } else { $CPAN::Frontend->mydie(qq{ CPAN.pm needs either both external programs tar and gzip installed or @@ -4471,6 +5656,188 @@ both the modules Archive::Tar and Compress::Zlib. Neither prerequisite is available. Can\'t continue. }); } + if ($prefer==1) { # 1 => external gzip+tar + my($system); + my $is_compressed = $class->gtest($file); + if ($is_compressed) { + $system = "$CPAN::Config->{gzip} --decompress --stdout " . + "< $file | $CPAN::Config->{tar} xvf -"; + } else { + $system = "$CPAN::Config->{tar} xvf $file"; + } + if (system($system) != 0) { + # people find the most curious tar binaries that cannot handle + # pipes + if ($is_compressed) { + (my $ungzf = $file) =~ s/\.gz(?!\n)\Z//; + if (CPAN::Tarzip->gunzip($file, $ungzf)) { + $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n}); + } else { + $CPAN::Frontend->mydie(qq{Couldn\'t uncompress $file\n}); + } + $file = $ungzf; + } + $system = "$CPAN::Config->{tar} xvf $file"; + $CPAN::Frontend->myprint(qq{Using Tar:$system:\n}); + if (system($system)==0) { + $CPAN::Frontend->myprint(qq{Untarred $file successfully\n}); + } else { + $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n}); + } + return 1; + } else { + return 1; + } + } elsif ($prefer==2) { # 2 => modules + my $tar = Archive::Tar->new($file,1); + my $af; # archive file + my @af; + if ($BUGHUNTING) { + # RCS 1.337 had this code, it turned out unacceptable slow but + # it revealed a bug in Archive::Tar. Code is only here to hunt + # the bug again. It should never be enabled in published code. + # GDGraph3d-0.53 was an interesting case according to Larry + # Virden. + warn(">>>Bughunting code enabled<<< " x 20); + for $af ($tar->list_files) { + if ($af =~ m!^(/|\.\./)!) { + $CPAN::Frontend->mydie("ALERT: Archive contains ". + "illegal member [$af]"); + } + $CPAN::Frontend->myprint("$af\n"); + $tar->extract($af); # slow but effective for finding the bug + return if $CPAN::Signal; + } + } else { + for $af ($tar->list_files) { + if ($af =~ m!^(/|\.\./)!) { + $CPAN::Frontend->mydie("ALERT: Archive contains ". + "illegal member [$af]"); + } + $CPAN::Frontend->myprint("$af\n"); + push @af, $af; + return if $CPAN::Signal; + } + $tar->extract(@af); + } + + ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1) + if ($^O eq 'MacOS'); + + return 1; + } +} + +sub unzip { + my($class,$file) = @_; + if ($CPAN::META->has_inst("Archive::Zip")) { + # blueprint of the code from Archive::Zip::Tree::extractTree(); + my $zip = Archive::Zip->new(); + my $status; + $status = $zip->read($file); + die "Read of file[$file] failed\n" if $status != Archive::Zip::AZ_OK(); + $CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG; + my @members = $zip->members(); + for my $member ( @members ) { + my $af = $member->fileName(); + if ($af =~ m!^(/|\.\./)!) { + $CPAN::Frontend->mydie("ALERT: Archive contains ". + "illegal member [$af]"); + } + my $status = $member->extractToFileNamed( $af ); + $CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG; + die "Extracting of file[$af] from zipfile[$file] failed\n" if + $status != Archive::Zip::AZ_OK(); + return if $CPAN::Signal; + } + return 1; + } else { + my $unzip = $CPAN::Config->{unzip} or + $CPAN::Frontend->mydie("Cannot unzip, no unzip program available"); + my @system = ($unzip, $file); + return system(@system) == 0; + } +} + + +package CPAN::Version; +# CPAN::Version::vcmp courtesy Jost Krieger +sub vcmp { + my($self,$l,$r) = @_; + local($^W) = 0; + CPAN->debug("l[$l] r[$r]") if $CPAN::DEBUG; + + return 0 if $l eq $r; # short circuit for quicker success + + if ($l=~/^v/ <=> $r=~/^v/) { + for ($l,$r) { + next if /^v/; + $_ = $self->float2vv($_); + } + } + + return + ($l ne "undef") <=> ($r ne "undef") || + ($] >= 5.006 && + $l =~ /^v/ && + $r =~ /^v/ && + $self->vstring($l) cmp $self->vstring($r)) || + $l <=> $r || + $l cmp $r; +} + +sub vgt { + my($self,$l,$r) = @_; + $self->vcmp($l,$r) > 0; +} + +sub vstring { + my($self,$n) = @_; + $n =~ s/^v// or die "CPAN::Version::vstring() called with invalid arg [$n]"; + pack "U*", split /\./, $n; +} + +# vv => visible vstring +sub float2vv { + my($self,$n) = @_; + my($rev) = int($n); + $rev ||= 0; + my($mantissa) = $n =~ /\.(\d{1,12})/; # limit to 12 digits to limit + # architecture influence + $mantissa ||= 0; + $mantissa .= "0" while length($mantissa)%3; + my $ret = "v" . $rev; + while ($mantissa) { + $mantissa =~ s/(\d{1,3})// or + die "Panic: length>0 but not a digit? mantissa[$mantissa]"; + $ret .= ".".int($1); + } + # warn "n[$n]ret[$ret]"; + $ret; +} + +sub readable { + my($self,$n) = @_; + $n =~ /^([\w\-\+\.]+)/; + + return $1 if defined $1 && length($1)>0; + # if the first user reaches version v43, he will be treated as "+". + # We'll have to decide about a new rule here then, depending on what + # will be the prevailing versioning behavior then. + + if ($] < 5.006) { # or whenever v-strings were introduced + # we get them wrong anyway, whatever we do, because 5.005 will + # have already interpreted 0.2.4 to be "0.24". So even if he + # indexer sends us something like "v0.2.4" we compare wrongly. + + # And if they say v1.2, then the old perl takes it as "v12" + + $CPAN::Frontend->mywarn("Suspicious version string seen [$n]"); + return $n; + } + my $better = sprintf "v%vd", $n; + CPAN->debug("n[$n] better[$better]") if $CPAN::DEBUG; + return $better; } package CPAN; @@ -4518,11 +5885,11 @@ the make processes and deletes excess space according to a simple FIFO mechanism. For extended searching capabilities there's a plugin for CPAN available, -L. C is a full-text search engine that indexes -all documents available in CPAN authors directories. If C -is installed on your system, the interactive shell of will -enable the C, C, C, C, and C commands which send -queries to the WAIT server that has been configured for your +L|CPAN::WAIT>. C is a full-text search engine +that indexes all documents available in CPAN authors directories. If +C is installed on your system, the interactive shell of +CPAN.pm will enable the C, C, C, C, and C commands +which send queries to the WAIT server that has been configured for your installation. All other methods provided are accessible in a programmer style and in an @@ -4541,6 +5908,10 @@ command completion. Once you are on the command line, type 'h' and the rest should be self-explanatory. +The function call C takes two optional arguments, one is the +prompt, the second is the default initial command line (the latter +only works if a real ReadLine interface module is installed). + The most common uses of the interactive modes are =over 2 @@ -4584,10 +5955,10 @@ also is run unconditionally. But for CPAN checks if an install is actually needed for it and prints I in the case that the distribution file containing -the module doesnE<39>t need to be updated. +the module doesn't need to be updated. CPAN also keeps track of what it has done within the current session -and doesnE<39>t try to build a package a second time regardless if it +and doesn't try to build a package a second time regardless if it succeeded or not. The C command takes as a first argument the method to invoke (currently: C, C, or C) and executes the command from scratch. @@ -4615,6 +5986,13 @@ displays the README file of the associated distribution. C gets and untars (if not yet done) the distribution file, changes to the appropriate directory and opens a subshell process in that directory. +=item ls author + +C lists all distribution files in and below an author's CPAN +directory. Only those files that contain modules are listed and if +there is more than one for any given module, only the most recent one +is listed. + =item Signals CPAN.pm installs signal handlers for SIGINT and SIGTERM. While you are @@ -4659,7 +6037,7 @@ installation. You start on one architecture with the help of a Bundle file produced earlier. CPAN installs the whole Bundle for you, but when you try to repeat the job on the second architecture, CPAN responds with a C<"Foo up to date"> message for all modules. So you -invoke CPAN's recompile on the second architecture and youE<39>re done. +invoke CPAN's recompile on the second architecture and you're done. Another popular use for C is to act as a rescue in case your perl breaks binary compatibility. If one of the modules that CPAN uses @@ -4704,7 +6082,7 @@ so you would have to say The first example will be driven by an object of the class CPAN::Module, the second by an object of class CPAN::Distribution. -=head2 ProgrammerE<39>s interface +=head2 Programmer's interface If you do not enter the shell, the available shell commands are both available as methods (Cinstall(...)>) and as @@ -4727,6 +6105,12 @@ list of CPAN::Module objects according to the C<@things> arguments given. In scalar context it only returns the first element of the list. +=item expandany(@things) + +Like expand, but returns objects of the appropriate type, i.e. +CPAN::Bundle objects for bundles, CPAN::Module objects for modules and +CPAN::Distribution objects fro distributions. + =item Programming Examples This enables the programmer to do operations that combine @@ -4749,18 +6133,21 @@ functionalities that are available in the shell. print "No VERSION in ", $mod->id, "\n"; } + # find out which distribution on CPAN contains a module: + print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file + Or if you want to write a cronjob to watch The CPAN, you could list -all modules that need updating: +all modules that need updating. First a quick and dirty way: perl -e 'use CPAN; CPAN::Shell->r;' -If you don't want to get any output if all modules are up to date, you -can parse the output of above command for the regular expression -//modules are up to date// and decide to mail the output only if it -doesn't match. Ick? +If you don't want to get any output in the case that all modules are +up to date, you can parse the output of above command for the regular +expression //modules are up to date// and decide to mail the output +only if it doesn't match. Ick? If you prefer to do it more in a programmer style in one single -process, maybe something like this suites you better: +process, maybe something like this suits you better: # list all modules on my disk that have newer versions on CPAN for $mod (CPAN::Shell->expand("Module","/./")){ @@ -4786,7 +6173,299 @@ tricks: =back -=head2 Methods in the four Classes +=head2 Methods in the other Classes + +The programming interface for the classes CPAN::Module, +CPAN::Distribution, CPAN::Bundle, and CPAN::Author is still considered +beta and partially even alpha. In the following paragraphs only those +methods are documented that have proven useful over a longer time and +thus are unlikely to change. + +=over + +=item CPAN::Author::as_glimpse() + +Returns a one-line description of the author + +=item CPAN::Author::as_string() + +Returns a multi-line description of the author + +=item CPAN::Author::email() + +Returns the author's email address + +=item CPAN::Author::fullname() + +Returns the author's name + +=item CPAN::Author::name() + +An alias for fullname + +=item CPAN::Bundle::as_glimpse() + +Returns a one-line description of the bundle + +=item CPAN::Bundle::as_string() + +Returns a multi-line description of the bundle + +=item CPAN::Bundle::clean() + +Recursively runs the C method on all items contained in the bundle. + +=item CPAN::Bundle::contains() + +Returns a list of objects' IDs contained in a bundle. The associated +objects may be bundles, modules or distributions. + +=item CPAN::Bundle::force($method,@args) + +Forces CPAN to perform a task that normally would have failed. Force +takes as arguments a method name to be called and any number of +additional arguments that should be passed to the called method. The +internals of the object get the needed changes so that CPAN.pm does +not refuse to take the action. The C is passed recursively to +all contained objects. + +=item CPAN::Bundle::get() + +Recursively runs the C method on all items contained in the bundle + +=item CPAN::Bundle::inst_file() + +Returns the highest installed version of the bundle in either @INC or +C<$CPAN::Config->{cpan_home}>. Note that this is different from +CPAN::Module::inst_file. + +=item CPAN::Bundle::inst_version() + +Like CPAN::Bundle::inst_file, but returns the $VERSION + +=item CPAN::Bundle::uptodate() + +Returns 1 if the bundle itself and all its members are uptodate. + +=item CPAN::Bundle::install() + +Recursively runs the C method on all items contained in the bundle + +=item CPAN::Bundle::make() + +Recursively runs the C method on all items contained in the bundle + +=item CPAN::Bundle::readme() + +Recursively runs the C method on all items contained in the bundle + +=item CPAN::Bundle::test() + +Recursively runs the C method on all items contained in the bundle + +=item CPAN::Distribution::as_glimpse() + +Returns a one-line description of the distribution + +=item CPAN::Distribution::as_string() + +Returns a multi-line description of the distribution + +=item CPAN::Distribution::clean() + +Changes to the directory where the distribution has been unpacked and +runs C there. + +=item CPAN::Distribution::containsmods() + +Returns a list of IDs of modules contained in a distribution file. +Only works for distributions listed in the 02packages.details.txt.gz +file. This typically means that only the most recent version of a +distribution is covered. + +=item CPAN::Distribution::cvs_import() + +Changes to the directory where the distribution has been unpacked and +runs something like + + cvs -d $cvs_root import -m $cvs_log $cvs_dir $userid v$version + +there. + +=item CPAN::Distribution::dir() + +Returns the directory into which this distribution has been unpacked. + +=item CPAN::Distribution::force($method,@args) + +Forces CPAN to perform a task that normally would have failed. Force +takes as arguments a method name to be called and any number of +additional arguments that should be passed to the called method. The +internals of the object get the needed changes so that CPAN.pm does +not refuse to take the action. + +=item CPAN::Distribution::get() + +Downloads the distribution from CPAN and unpacks it. Does nothing if +the distribution has already been downloaded and unpacked within the +current session. + +=item CPAN::Distribution::install() + +Changes to the directory where the distribution has been unpacked and +runs the external command C there. If C has not +yet been run, it will be run first. A C will be issued in +any case and if this fails, the install will be cancelled. The +cancellation can be avoided by letting C run the C for +you. + +=item CPAN::Distribution::isa_perl() + +Returns 1 if this distribution file seems to be a perl distribution. +Normally this is derived from the file name only, but the index from +CPAN can contain a hint to achieve a return value of true for other +filenames too. + +=item CPAN::Distribution::look() + +Changes to the directory where the distribution has been unpacked and +opens a subshell there. Exiting the subshell returns. + +=item CPAN::Distribution::make() + +First runs the C method to make sure the distribution is +downloaded and unpacked. Changes to the directory where the +distribution has been unpacked and runs the external commands C and C there. + +=item CPAN::Distribution::prereq_pm() + +Returns the hash reference that has been announced by a distribution +as the PREREQ_PM hash in the Makefile.PL. Note: works only after an +attempt has been made to C the distribution. Returns undef +otherwise. + +=item CPAN::Distribution::readme() + +Downloads the README file associated with a distribution and runs it +through the pager specified in C<$CPAN::Config->{pager}>. + +=item CPAN::Distribution::test() + +Changes to the directory where the distribution has been unpacked and +runs C there. + +=item CPAN::Distribution::uptodate() + +Returns 1 if all the modules contained in the distribution are +uptodate. Relies on containsmods. + +=item CPAN::Index::force_reload() + +Forces a reload of all indices. + +=item CPAN::Index::reload() + +Reloads all indices if they have been read more than +C<$CPAN::Config->{index_expire}> days. + +=item CPAN::InfoObj::dump() + +CPAN::Author, CPAN::Bundle, CPAN::Module, and CPAN::Distribution +inherit this method. It prints the data structure associated with an +object. Useful for debugging. Note: the data structure is considered +internal and thus subject to change without notice. + +=item CPAN::Module::as_glimpse() + +Returns a one-line description of the module + +=item CPAN::Module::as_string() + +Returns a multi-line description of the module + +=item CPAN::Module::clean() + +Runs a clean on the distribution associated with this module. + +=item CPAN::Module::cpan_file() + +Returns the filename on CPAN that is associated with the module. + +=item CPAN::Module::cpan_version() + +Returns the latest version of this module available on CPAN. + +=item CPAN::Module::cvs_import() + +Runs a cvs_import on the distribution associated with this module. + +=item CPAN::Module::description() + +Returns a 44 chracter description of this module. Only available for +modules listed in The Module List (CPAN/modules/00modlist.long.html +or 00modlist.long.txt.gz) + +=item CPAN::Module::force($method,@args) + +Forces CPAN to perform a task that normally would have failed. Force +takes as arguments a method name to be called and any number of +additional arguments that should be passed to the called method. The +internals of the object get the needed changes so that CPAN.pm does +not refuse to take the action. + +=item CPAN::Module::get() + +Runs a get on the distribution associated with this module. + +=item CPAN::Module::inst_file() + +Returns the filename of the module found in @INC. The first file found +is reported just like perl itself stops searching @INC when it finds a +module. + +=item CPAN::Module::inst_version() + +Returns the version number of the module in readable format. + +=item CPAN::Module::install() + +Runs an C on the distribution associated with this module. + +=item CPAN::Module::look() + +Changes to the directory where the distribution assoicated with this +module has been unpacked and opens a subshell there. Exiting the +subshell returns. + +=item CPAN::Module::make() + +Runs a C on the distribution associated with this module. + +=item CPAN::Module::manpage_headline() + +If module is installed, peeks into the module's manpage, reads the +headline and returns it. Moreover, if the module has been downloaded +within this session, does the equivalent on the downloaded module even +if it is not installed. + +=item CPAN::Module::readme() + +Runs a C on the distribution associated with this module. + +=item CPAN::Module::test() + +Runs a C on the distribution associated with this module. + +=item CPAN::Module::uptodate() + +Returns 1 if the module is installed and up-to-date. + +=item CPAN::Module::userid() + +Returns the author's ID of the module. + +=back =head2 Cache Manager @@ -4880,17 +6559,18 @@ enthusiasm). =head2 Debugging -The debugging of this module is pretty difficult, because we have +The debugging of this module is a bit complex, because we have interferences of the software producing the indices on CPAN, of the mirroring process on CPAN, of packaging, of configuration, of synchronicity, and of bugs within CPAN.pm. -In interactive mode you can try "o debug" which will list options for -debugging the various parts of the package. The output may not be very -useful for you as it's just a by-product of my own testing, but if you -have an idea which part of the package may have a bug, it's sometimes -worth to give it a try and send me more specific output. You should -know that "o debug" has built-in completion support. +For code debugging in interactive mode you can try "o debug" which +will list options for debugging the various parts of the code. You +should know that "o debug" has built-in completion support. + +For data debugging there is the C command which takes the same +arguments as make/test/install and outputs the object's Data::Dumper +dump. =head2 Floppy, Zip, Offline Mode @@ -4918,7 +6598,10 @@ defined: build_cache size of cache for directories to build modules build_dir locally accessible directory to build modules index_expire after this many days refetch index files + cache_metadata use serializer to cache metadata cpan_home local directory reserved for this package + dontload_hash anonymous hash: modules in the keys will not be + loaded by the CPAN::has_inst() routine gzip location of external program gzip inactivity_timeout breaks interactive Makefile.PLs after this many seconds inactivity. Set to 0 to never break. @@ -4933,8 +6616,12 @@ defined: prerequisites_policy what to do if you are missing module prerequisites ('follow' automatically, 'ask' me, or 'ignore') + proxy_user username for accessing an authenticating proxy + proxy_pass password for accessing an authenticating proxy scan_cache controls scanning of cache ('atstart' or 'never') tar location of external program tar + term_is_latin if true internal UTF-8 is translated to ISO-8859-1 + (and nonsense for characters outside latin range) unzip location of external program unzip urllist arrayref to nearby CPAN sites (or equivalent locations) wait_list arrayref to a wait server to try (See CPAN::WAIT) @@ -4973,7 +6660,8 @@ works like the corresponding perl commands. =head2 Note on urllist parameter's format urllist parameters are URLs according to RFC 1738. We do a little -guessing if your URL is not compliant, but if you have problems with file URLs, please try the correct format. Either: +guessing if your URL is not compliant, but if you have problems with +file URLs, please try the correct format. Either: file://localhost/whatever/ftp/pub/CPAN/ @@ -5021,8 +6709,8 @@ oneliners. =head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES -To populate a freshly installed perl with my favorite modules is pretty -easiest by maintaining a private bundle definition file. To get a useful +Populating a freshly installed perl with my favorite modules is pretty +easy if you maintain a private bundle definition file. To get a useful blueprint of a bundle definition file, the command autobundle can be used on the CPAN shell command line. This command writes a bundle definition file for all modules that are installed for the currently running perl @@ -5034,7 +6722,7 @@ Bundle/my_bundle.pm. With a clever bundle file you can then simply say then answer a few questions and then go out for a coffee. -Maintaining a bundle definition file means to keep track of two +Maintaining a bundle definition file means keeping track of two things: dependencies and interactivity. CPAN.pm sometimes fails on calculating dependencies because not all modules define all MakeMaker attributes correctly, so a bundle definition file should specify @@ -5043,12 +6731,18 @@ annoying that many distributions need some interactive configuring. So what I try to accomplish in my private bundle file is to have the packages that need to be configured early in the file and the gentle ones later, so I can go out after a few minutes and leave CPAN.pm -unattained. +untended. =head1 WORKING WITH CPAN.pm BEHIND FIREWALLS Thanks to Graham Barr for contributing the following paragraphs about -the interaction between perl, and various firewall configurations. +the interaction between perl, and various firewall configurations. For +further informations on firewalls, it is recommended to consult the +documentation that comes with the ncftp program. If you are unable to +go through the firewall with a simple Perl setup, it is very likely +that you can configure ncftp so that it works for your firewall. + +=head2 Three basic types of firewalls Firewalls can be categorized into three basic types. @@ -5091,7 +6785,7 @@ There are two that I can think off. =item SOCKS If you are using a SOCKS firewall you will need to compile perl and link -it with the SOCKS library, this is what is normally called a ``socksified'' +it with the SOCKS library, this is what is normally called a 'socksified' perl. With this executable you will be able to connect to servers outside the firewall as if it is not there. @@ -5099,18 +6793,179 @@ the firewall as if it is not there. This is the firewall implemented in the Linux kernel, it allows you to hide a complete network behind one IP address. With this firewall no -special compiling is need as you can access hosts directly. +special compiling is needed as you can access hosts directly. =back =back +=head2 Configuring lynx or ncftp for going through a firewall + +If you can go through your firewall with e.g. lynx, presumably with a +command such as + + /usr/local/bin/lynx -pscott:tiger + +then you would configure CPAN.pm with the command + + o conf lynx "/usr/local/bin/lynx -pscott:tiger" + +That's all. Similarly for ncftp or ftp, you would configure something +like + + o conf ncftp "/usr/bin/ncftp -f /home/scott/ncftplogin.cfg" + +Your milage may vary... + +=head1 FAQ + +=over + +=item 1) + +I installed a new version of module X but CPAN keeps saying, +I have the old version installed + +Most probably you B have the old version installed. This can +happen if a module installs itself into a different directory in the +@INC path than it was previously installed. This is not really a +CPAN.pm problem, you would have the same problem when installing the +module manually. The easiest way to prevent this behaviour is to add +the argument C to the C call, and that is why +many people add this argument permanently by configuring + + o conf make_install_arg UNINST=1 + +=item 2) + +So why is UNINST=1 not the default? + +Because there are people who have their precise expectations about who +may install where in the @INC path and who uses which @INC array. In +fine tuned environments C can cause damage. + +=item 3) + +I want to clean up my mess, and install a new perl along with +all modules I have. How do I go about it? + +Run the autobundle command for your old perl and optionally rename the +resulting bundle file (e.g. Bundle/mybundle.pm), install the new perl +with the Configure option prefix, e.g. + + ./Configure -Dprefix=/usr/local/perl-5.6.78.9 + +Install the bundle file you produced in the first step with something like + + cpan> install Bundle::mybundle + +and you're done. + +=item 4) + +When I install bundles or multiple modules with one command +there is too much output to keep track of. + +You may want to configure something like + + o conf make_arg "| tee -ai /root/.cpan/logs/make.out" + o conf make_install_arg "| tee -ai /root/.cpan/logs/make_install.out" + +so that STDOUT is captured in a file for later inspection. + + +=item 5) + +I am not root, how can I install a module in a personal directory? + +You will most probably like something like this: + + o conf makepl_arg "LIB=~/myperl/lib \ + INSTALLMAN1DIR=~/myperl/man/man1 \ + INSTALLMAN3DIR=~/myperl/man/man3" + install Sybase::Sybperl + +You can make this setting permanent like all C settings with +C. + +You will have to add ~/myperl/man to the MANPATH environment variable +and also tell your perl programs to look into ~/myperl/lib, e.g. by +including + + use lib "$ENV{HOME}/myperl/lib"; + +or setting the PERL5LIB environment variable. + +Another thing you should bear in mind is that the UNINST parameter +should never be set if you are not root. + +=item 6) + +How to get a package, unwrap it, and make a change before building it? + + look Sybase::Sybperl + +=item 7) + +I installed a Bundle and had a couple of fails. When I +retried, everything resolved nicely. Can this be fixed to work +on first try? + +The reason for this is that CPAN does not know the dependencies of all +modules when it starts out. To decide about the additional items to +install, it just uses data found in the generated Makefile. An +undetected missing piece breaks the process. But it may well be that +your Bundle installs some prerequisite later than some depending item +and thus your second try is able to resolve everything. Please note, +CPAN.pm does not know the dependency tree in advance and cannot sort +the queue of things to install in a topologically correct order. It +resolves perfectly well IFF all modules declare the prerequisites +correctly with the PREREQ_PM attribute to MakeMaker. For bundles which +fail and you need to install often, it is recommended sort the Bundle +definition file manually. It is planned to improve the metadata +situation for dependencies on CPAN in general, but this will still +take some time. + +=item 8) + +In our intranet we have many modules for internal use. How +can I integrate these modules with CPAN.pm but without uploading +the modules to CPAN? + +Have a look at the CPAN::Site module. + +=item 9) + +When I run CPAN's shell, I get error msg about line 1 to 4, +setting meta input/output via the /etc/inputrc file. + +Some versions of readline are picky about capitalization in the +/etc/inputrc file and specifically RedHat 6.2 comes with a +/etc/inputrc that contains the word C in lowercase. Change the +occurrences of C to C and the bug should disappear. + +=item 10) + +Some authors have strange characters in their names. + +Internally CPAN.pm uses the UTF-8 charset. If your terminal is +expecting ISO-8859-1 charset, a converter can be activated by setting +term_is_latin to a true value in your config file. One way of doing so +would be + + cpan> ! $CPAN::Config->{term_is_latin}=1 + +Extended support for converters will be made available as soon as perl +becomes stable with regard to charset issues. + +=back + =head1 BUGS We should give coverage for B of the CPAN and not just the PAUSE part, right? In this discussion CPAN and PAUSE have become equal -- -but they are not. PAUSE is authors/ and modules/. CPAN is PAUSE plus -the clpa/, doc/, misc/, ports/, src/, scripts/. +but they are not. PAUSE is authors/, modules/ and scripts/. CPAN is +PAUSE plus the clpa/, doc/, misc/, ports/, and src/. Future development should be directed towards a better integration of the other parts. @@ -5124,6 +6979,11 @@ traditional method of building a Perl module package from a shell. Andreas Koenig Eandreas.koenig@anima.deE +=head1 TRANSLATIONS + +Kawai,Takanori provides a Japanese translation of this manpage at +http://member.nifty.ne.jp/hippo2000/perltips/CPAN.htm + =head1 SEE ALSO perl(1), CPAN::Nox(3) diff --git a/contrib/perl5/lib/CPAN/FirstTime.pm b/contrib/perl5/lib/CPAN/FirstTime.pm index 0e795da4fb0a..0429db15270f 100644 --- a/contrib/perl5/lib/CPAN/FirstTime.pm +++ b/contrib/perl5/lib/CPAN/FirstTime.pm @@ -1,3 +1,4 @@ +# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- package CPAN::Mirrored::By; sub new { @@ -16,7 +17,7 @@ use FileHandle (); use File::Basename (); use File::Path (); use vars qw($VERSION); -$VERSION = substr q$Revision: 1.38 $, 10; +$VERSION = substr q$Revision: 1.53 $, 10; =head1 NAME @@ -149,7 +150,7 @@ next question. print qq{ How big should the disk cache be for keeping the build directories -with all the intermediate files? +with all the intermediate files\? }; @@ -174,6 +175,47 @@ disable the cache scanning with 'never'. } while ($ans ne 'atstart' && $ans ne 'never'); $CPAN::Config->{scan_cache} = $ans; + # + # cache_metadata + # + print qq{ + +To considerably speed up the initial CPAN shell startup, it is +possible to use Storable to create a cache of metadata. If Storable +is not available, the normal index mechanism will be used. + +}; + + defined($default = $CPAN::Config->{cache_metadata}) or $default = 1; + do { + $ans = prompt("Cache metadata (yes/no)?", ($default ? 'yes' : 'no')); + } while ($ans !~ /^\s*[yn]/i); + $CPAN::Config->{cache_metadata} = ($ans =~ /^\s*y/i ? 1 : 0); + + # + # term_is_latin + # + print qq{ + +The next option deals with the charset your terminal supports. In +general CPAN is English speaking territory, thus the charset does not +matter much, but some of the aliens out there who upload their +software to CPAN bear names that are outside the ASCII range. If your +terminal supports UTF-8, you say no to the next question, if it +supports ISO-8859-1 (also known as LATIN1) then you say yes, and if it +supports neither nor, your answer does not matter, you will not be +able to read the names of some authors anyway. If you answer no, names +will be output in UTF-8. + +}; + + defined($default = $CPAN::Config->{term_is_latin}) or $default = 1; + do { + $ans = prompt("Your terminal expects ISO-8859-1 (yes/no)?", + ($default ? 'yes' : 'no')); + } while ($ans !~ /^\s*[yn]/i); + $CPAN::Config->{term_is_latin} = ($ans =~ /^\s*y/i ? 1 : 0); + # # prerequisites_policy # Do we follow PREREQ_PM? @@ -188,7 +230,7 @@ policy to one of the three values. }; - $default = $CPAN::Config->{prerequisites_policy} || 'follow'; + $default = $CPAN::Config->{prerequisites_policy} || 'ask'; do { $ans = prompt("Policy on building prerequisites (follow, ask or ignore)?", @@ -202,10 +244,11 @@ policy to one of the three values. print qq{ -The CPAN module will need a few external programs to work -properly. Please correct me, if I guess the wrong path for a program. -Don\'t panic if you do not have some of them, just press ENTER for -those. +The CPAN module will need a few external programs to work properly. +Please correct me, if I guess the wrong path for a program. Don\'t +panic if you do not have some of them, just press ENTER for those. To +disable the use of a download program, you can type a space followed +by ENTER. }; @@ -214,7 +257,7 @@ those. my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'}; local $^W = $old_warn; my $progname; - for $progname (qw/gzip tar unzip make lynx ncftpget ncftp ftp/){ + for $progname (qw/gzip tar unzip make lynx wget ncftpget ncftp ftp/){ if ($^O eq 'MacOS') { $CPAN::Config->{$progname} = 'not_here'; next; @@ -272,9 +315,9 @@ those. print qq{ Every Makefile.PL is run by perl in a separate process. Likewise we -run \'make\' and \'make install\' in processes. If you have any parameters -\(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to -the calls, please specify them here. +run \'make\' and \'make install\' in processes. If you have any +parameters \(e.g. PREFIX, LIB, UNINST or the like\) you want to pass +to the calls, please specify them here. If you don\'t understand this question, just press ENTER. @@ -282,13 +325,29 @@ If you don\'t understand this question, just press ENTER. $default = $CPAN::Config->{makepl_arg} || ""; $CPAN::Config->{makepl_arg} = - prompt("Parameters for the 'perl Makefile.PL' command?",$default); + prompt("Parameters for the 'perl Makefile.PL' command? +Typical frequently used settings: + + POLLUTE=1 increasing backwards compatibility + LIB=~/perl non-root users (please see manual for more hints) + +Your choice: ",$default); $default = $CPAN::Config->{make_arg} || ""; - $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command?",$default); + $CPAN::Config->{make_arg} = prompt("Parameters for the 'make' command? +Typical frequently used setting: + + -j3 dual processor system + +Your choice: ",$default); $default = $CPAN::Config->{make_install_arg} || $CPAN::Config->{make_arg} || ""; $CPAN::Config->{make_install_arg} = - prompt("Parameters for the 'make install' command?",$default); + prompt("Parameters for the 'make install' command? +Typical frequently used setting: + + UNINST=1 to always uninstall potentially conflicting files + +Your choice: ",$default); # # Alarm period @@ -325,6 +384,44 @@ the \$CPAN::Config takes precedence. $CPAN::Config->{$_} = prompt("Your $_?",$default); } + if ($CPAN::Config->{ftp_proxy} || + $CPAN::Config->{http_proxy}) { + $default = $CPAN::Config->{proxy_user} || $CPAN::LWP::UserAgent::USER; + print qq{ + +If your proxy is an authenticating proxy, you can store your username +permanently. If you do not want that, just press RETURN. You will then +be asked for your username in every future session. + +}; + if ($CPAN::Config->{proxy_user} = prompt("Your proxy user id?",$default)) { + print qq{ + +Your password for the authenticating proxy can also be stored +permanently on disk. If this violates your security policy, just press +RETURN. You will then be asked for the password in every future +session. + +}; + + if ($CPAN::META->has_inst("Term::ReadKey")) { + Term::ReadKey::ReadMode("noecho"); + } else { + print qq{ + +Warning: Term::ReadKey seems not to be available, your password will +be echoed to the terminal! + +}; + } + $CPAN::Config->{proxy_pass} = prompt("Your proxy password?"); + if ($CPAN::META->has_inst("Term::ReadKey")) { + Term::ReadKey::ReadMode("restore"); + } + $CPAN::Frontend->myprint("\n\n"); + } + } + # # MIRRORED.BY # @@ -361,8 +458,27 @@ sub conf_sites { File::Copy::copy($m,$mby) or die "Could not update $mby: $!"; } my $loopcount = 0; - while () { - if ( ! -f $mby ){ + local $^T = time; + my $overwrite_local = 0; + if ($mby && -f $mby && -M _ <= 60 && -s _ > 0) { + my $mtime = localtime((stat _)[9]); + my $prompt = qq{Found $mby as of $mtime + +I\'d use that as a database of CPAN sites. If that is OK for you, +please answer 'y', but if you want me to get a new database now, +please answer 'n' to the following question. + +Shall I use the local database in $mby?}; + my $ans = prompt($prompt,"y"); + $overwrite_local = 1 unless $ans =~ /^y/i; + } + while ($mby) { + if ($overwrite_local) { + print qq{Trying to overwrite $mby +}; + $mby = CPAN::FTP->localize($m,$mby,3); + $overwrite_local = 0; + } elsif ( ! -f $mby ){ print qq{You have no $mby I\'m trying to fetch one }; @@ -383,6 +499,7 @@ sub conf_sites { } } read_mirrored_by($mby); + bring_your_own(); } sub find_exe { @@ -424,7 +541,7 @@ sub picklist { } sub read_mirrored_by { - my($local) = @_; + my $local = shift or return; my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location); my $fh = FileHandle->new; $fh->open($local) or die "Couldn't open $local: $!"; @@ -503,7 +620,8 @@ http: -- that host a CPAN mirror. } } push (@urls, map ("$_ (previous pick)", @previous_urls)); - my $prompt = "Select as many URLs as you like"; + my $prompt = "Select as many URLs as you like, +put them on one line, separated by blanks"; if (@previous_urls) { $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) .. (scalar @urls)); @@ -512,25 +630,37 @@ http: -- that host a CPAN mirror. @urls = picklist (\@urls, $prompt, $default); foreach (@urls) { s/ \(.*\)//; } - %seen = map (($_ => 1), @urls); + push @{$CPAN::Config->{urllist}}, @urls; +} +sub bring_your_own { + my %seen = map (($_ => 1), @{$CPAN::Config->{urllist}}); + my($ans,@urls); do { - $ans = prompt ("Enter another URL or RETURN to quit:", ""); + my $prompt = "Enter another URL or RETURN to quit:"; + unless (%seen) { + $prompt = qq{CPAN.pm needs at least one URL where it can fetch CPAN files from. + +Please enter your CPAN site:}; + } + $ans = prompt ($prompt, ""); if ($ans) { - $ans =~ s|/?$|/|; # has to end with one slash + $ans =~ s|/?\z|/|; # has to end with one slash $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file: if ($ans =~ /^\w+:\/./) { - push @urls, $ans - unless $seen{$ans}; - } - else { - print qq{"$ans" doesn\'t look like an URL at first sight. -I\'ll ignore it for now. You can add it to $INC{'CPAN/MyConfig.pm'} -later if you\'re sure it\'s right.\n}; + push @urls, $ans unless $seen{$ans}++; + } else { + printf(qq{"%s" doesn\'t look like an URL at first sight. +I\'ll ignore it for now. +You can add it to your %s +later if you\'re sure it\'s right.\n}, + $ans, + $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'} || "configuration file", + ); } } - } while $ans; + } while $ans || !%seen; push @{$CPAN::Config->{urllist}}, @urls; # xxx delete or comment these out when you're happy that it works diff --git a/contrib/perl5/lib/Carp/Heavy.pm b/contrib/perl5/lib/Carp/Heavy.pm index 5e3de49418b2..4d12bd79106c 100644 --- a/contrib/perl5/lib/Carp/Heavy.pm +++ b/contrib/perl5/lib/Carp/Heavy.pm @@ -42,7 +42,7 @@ sub longmess_heavy { # # if the $error error string is newline terminated then it # is copied into $mess. Otherwise, $mess gets set (at the end of - # the 'else {' section below) to one of two things. The first time + # the 'else' section below) to one of two things. The first time # through, it is set to the "$error at $file line $line" message. # $error is then set to 'called' which triggers subsequent loop # iterations to append $sub to $mess before appending the "$error @@ -121,10 +121,7 @@ sub longmess_heavy { # $line" makes sense as "called at $file line $line". $error = "called"; } - # this kludge circumvents die's incorrect handling of NUL - my $msg = \($mess || $error); - $$msg =~ tr/\0//d; - $$msg; + $mess || $error; } @@ -227,17 +224,14 @@ CALLER: } else { # OK! We've got a candidate package. Time to construct the - # relevant error message and return it. die() doesn't like - # to be given NUL characters (which $msg may contain) so we - # remove them first. + # relevant error message and return it. my $msg; $msg = "$error at $file line $line"; if (defined &Thread::tid) { my $tid = Thread->self->tid; - $mess .= " thread $tid" if $tid; + $msg .= " thread $tid" if $tid; } $msg .= "\n"; - $msg =~ tr/\0//d; return $msg; } } diff --git a/contrib/perl5/lib/Class/Struct.pm b/contrib/perl5/lib/Class/Struct.pm index 63eddac7393b..185a8ff142c0 100644 --- a/contrib/perl5/lib/Class/Struct.pm +++ b/contrib/perl5/lib/Class/Struct.pm @@ -14,7 +14,7 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(struct); -$VERSION = '0.58'; +$VERSION = '0.59'; ## Tested on 5.002 and 5.003 without class membership tests: my $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95); @@ -51,6 +51,20 @@ sub printem { sub DESTROY { } } +sub import { + my $self = shift; + + if ( @_ == 0 ) { + $self->export_to_level( 1, $self, @EXPORT ); + } elsif ( @_ == 1 ) { + # This is admittedly a little bit silly: + # do we ever export anything else than 'struct'...? + $self->export_to_level( 1, $self, @_ ); + } else { + &struct; + } +} + sub struct { # Determine parameter list structure, one of: @@ -76,6 +90,7 @@ sub struct { $class = (caller())[0]; @decls = @_; } + _usage_error() if @decls % 2 == 1; # Ensure we are not, and will not be, a subclass. @@ -168,8 +183,7 @@ sub struct { $cnt = 0; foreach $name (@methods){ if ( do { no strict 'refs'; defined &{$class . "::$name"} } ) { - warnings::warn "function '$name' already defined, overrides struct accessor method" - if warnings::enabled(); + warnings::warnif("function '$name' already defined, overrides struct accessor method"); } else { $pre = $pst = $cmt = $sel = ''; @@ -243,6 +257,9 @@ Class::Struct - declare struct-like datatypes as Perl classes # declare struct, based on array, implicit class name: struct( ELEMENT_NAME => ELEMENT_TYPE, ... ); + # Declare struct at compile time + use Class::Struct CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]; + use Class::Struct CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... }; package Myobj; use Class::Struct; @@ -263,14 +280,13 @@ Class::Struct - declare struct-like datatypes as Perl classes # hash type accessor: $hash_ref = $obj->h; # reference to whole hash $hash_element_value = $obj->h('x'); # hash element value - $obj->h('x', 'new value'); # assign to hash element + $obj->h('x', 'new value'); # assign to hash element # class type accessor: $element_value = $obj->c; # object reference $obj->c->method(...); # call method of object $obj->c(new My_Other_Class); # assign a new object - =head1 DESCRIPTION C exports a single function, C. @@ -288,7 +304,6 @@ same name in the package. (See Example 2.) Each element's type can be scalar, array, hash, or class. - =head2 The C function The C function has three forms of parameter-list. @@ -327,6 +342,15 @@ element name will be defined as an accessor method unless a method by that name is explicitly defined; in the latter case, a warning is issued if the warning flag (B<-w>) is set. +=head2 Class Creation at Compile Time + +C can create your class at compile time. The main reason +for doing this is obvious, so your class acts like every other class in +Perl. Creating your class at compile time will make the order of events +similar to using any other class ( or Perl module ). + +There is no significant speed gain between compile time and run time +class creation, there is just a new, more standard order of events. =head2 Element Types and Accessor Methods @@ -411,7 +435,6 @@ contents of that hash are passed to the element's own constructor. See Example 3 below for an example of initialization. - =head1 EXAMPLES =over @@ -445,7 +468,6 @@ type C. $t->ru_stime->tv_secs(5); $t->ru_stime->tv_usecs(0); - =item Example 2 An accessor function can be redefined in order to provide @@ -493,7 +515,6 @@ Note that the initializer for a nested struct is specified as an anonymous hash of initializers, which is passed on to the nested struct's constructor. - use Class::Struct; struct Breed => @@ -525,6 +546,9 @@ struct's constructor. =head1 Author and Modification History +Modified by Casey Tweten, 2000-11-08, v0.59. + + Added the ability for compile time class creation. Modified by Damian Conway, 1999-03-05, v0.58. @@ -542,7 +566,6 @@ Modified by Damian Conway, 1999-03-05, v0.58. Previously these were returned as a reference to a reference to the element. - Renamed to C and modified by Jim Miner, 1997-04-02. members() function removed. @@ -554,7 +577,6 @@ Renamed to C and modified by Jim Miner, 1997-04-02. Class name to struct() made optional. Diagnostic checks added. - Originally C by Dean Roehrich. # Template.pm --- struct/member template builder diff --git a/contrib/perl5/lib/Cwd.pm b/contrib/perl5/lib/Cwd.pm index 9a92829da5e4..9c7b33d9fc2e 100644 --- a/contrib/perl5/lib/Cwd.pm +++ b/contrib/perl5/lib/Cwd.pm @@ -3,7 +3,7 @@ require 5.000; =head1 NAME -getcwd - get pathname of current working directory +Cwd - get pathname of current working directory =head1 SYNOPSIS @@ -13,6 +13,9 @@ getcwd - get pathname of current working directory use Cwd; $dir = getcwd; + use Cwd; + $dir = fastcwd; + use Cwd; $dir = fastgetcwd; @@ -28,16 +31,21 @@ getcwd - get pathname of current working directory =head1 DESCRIPTION +This module provides functions for determining the pathname of the +current working directory. By default, it exports the functions +cwd(), getcwd(), fastcwd(), and fastgetcwd() into the caller's +namespace. Each of these functions are called without arguments and +return the absolute path of the current working directory. It is +recommended that cwd (or another *cwd() function) be used in I +code to ensure portability. + +The cwd() is the most natural and safe form for the current +architecture. For most systems it is identical to `pwd` (but without +the trailing line terminator). + The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions in Perl. -The abs_path() function takes a single argument and returns the -absolute pathname for that argument. It uses the same algorithm -as getcwd(). (Actually, getcwd() is abs_path(".")) Symbolic links -and relative-path components ("." and "..") are resolved to return -the canonical pathname, just like realpath(3). Also callable as -realpath(). - The fastcwd() function looks the same as getcwd(), but runs faster. It's also more dangerous because it might conceivably chdir() you out of a directory that it can't chdir() you back into. If fastcwd @@ -48,16 +56,17 @@ that it leaves you in the same directory that it started in. If it has changed it will C with the message "Unstable directory path, current directory changed unexpectedly". That should never happen. -The fast_abs_path() function looks the same as abs_path(), but runs faster. -And like fastcwd() is more dangerous. +The fastgetcwd() function is provided as a synonym for cwd(). -The cwd() function looks the same as getcwd and fastgetcwd but is -implemented using the most natural and safe form for the current -architecture. For most systems it is identical to `pwd` (but without -the trailing line terminator). +The abs_path() function takes a single argument and returns the +absolute pathname for that argument. It uses the same algorithm as +getcwd(). (Actually, getcwd() is abs_path(".")) Symbolic links and +relative-path components ("." and "..") are resolved to return the +canonical pathname, just like realpath(3). This function is also +callable as realpath(). -It is recommended that cwd (or another *cwd() function) is used in -I code to ensure portability. +The fast_abs_path() function looks the same as abs_path() but runs +faster and, like fastcwd(), is more dangerous. If you ask to override your chdir() built-in function, then your PWD environment variable will be kept up to date. (See @@ -66,31 +75,42 @@ kept up to date if all packages which use chdir import it from Cwd. =cut -## use strict; +use strict; use Carp; -$VERSION = '2.02'; +our $VERSION = '2.04'; -require Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(cwd getcwd fastcwd fastgetcwd); -@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath); +use base qw/ Exporter /; +our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd); +our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath); # The 'natural and safe form' for UNIX (pwd may be setuid root) sub _backtick_pwd { - my $cwd; - chop($cwd = `pwd`); + my $cwd = `pwd`; + # `pwd` may fail e.g. if the disk is full + chomp($cwd) if defined $cwd; $cwd; } # Since some ports may predefine cwd internally (e.g., NT) # we take care not to override an existing definition for cwd(). -*cwd = \&_backtick_pwd unless defined &cwd; +unless(defined &cwd) { + # The pwd command is not available in some chroot(2)'ed environments + if($^O eq 'MacOS' || grep { -x "$_/pwd" } split(':', $ENV{PATH})) { + *cwd = \&_backtick_pwd; + } + else { + *cwd = \&getcwd; + } +} +# set a reasonable (and very safe) default for fastgetcwd, in case it +# isn't redefined later (20001212 rspier) +*fastgetcwd = \&cwd; # By Brandon S. Allbery # @@ -156,7 +176,7 @@ sub fastcwd { my $chdir_init = 0; sub chdir_init { - if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos') { + if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') { my($dd,$di) = stat('.'); my($pd,$pi) = stat($ENV{'PWD'}); if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) { @@ -164,10 +184,12 @@ sub chdir_init { } } else { - $ENV{'PWD'} = cwd(); + my $wd = cwd(); + $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32'; + $ENV{'PWD'} = $wd; } # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar) - if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) { + if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) { my($pd,$pi) = stat($2); my($dd,$di) = stat($1); if (defined $pd and defined $dd and $di == $pi and $dd == $pd) { @@ -178,11 +200,27 @@ sub chdir_init { } sub chdir { - my $newdir = shift || ''; # allow for no arg (chdir to HOME dir) - $newdir =~ s|///*|/|g; + my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir) + $newdir =~ s|///*|/|g unless $^O eq 'MSWin32'; chdir_init() unless $chdir_init; + my $newpwd; + if ($^O eq 'MSWin32') { + # get the full path name *before* the chdir() + $newpwd = Win32::GetFullPathName($newdir); + } + return 0 unless CORE::chdir $newdir; - if ($^O eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} } + + if ($^O eq 'VMS') { + return $ENV{'PWD'} = $ENV{'DEFAULT'} + } + elsif ($^O eq 'MacOS') { + return $ENV{'PWD'} = cwd(); + } + elsif ($^O eq 'MSWin32') { + $ENV{'PWD'} = $newpwd; + return 1; + } if ($newdir =~ m#^/#s) { $ENV{'PWD'} = $newdir; @@ -263,7 +301,7 @@ sub abs_path sub fast_abs_path { my $cwd = getcwd(); - my $path = shift || '.'; + my $path = @_ ? shift : '.'; CORE::chdir($path) || croak "Cannot chdir to $path:$!"; my $realpath = getcwd(); CORE::chdir($cwd) || croak "Cannot chdir back to $cwd:$!"; @@ -332,12 +370,17 @@ sub _qnx_cwd { } sub _qnx_abs_path { - my $path = shift || '.'; + my $path = @_ ? shift : '.'; my $realpath=`/usr/bin/fullpath -t $path`; chop $realpath; return $realpath; } +sub _epoc_cwd { + $ENV{'PWD'} = EPOC::getcwd(); + return $ENV{'PWD'}; +} + { no warnings; # assignments trigger 'subroutine redefined' warning @@ -386,6 +429,19 @@ sub _qnx_abs_path { *fastcwd = \&cwd; *abs_path = \&fast_abs_path; } + elsif ($^O eq 'epoc') { + *cwd = \&_epoc_cwd; + *getcwd = \&_epoc_cwd; + *fastgetcwd = \&_epoc_cwd; + *fastcwd = \&_epoc_cwd; + *abs_path = \&fast_abs_path; + } + elsif ($^O eq 'MacOS') { + *getcwd = \&cwd; + *fastgetcwd = \&cwd; + *fastcwd = \&cwd; + *abs_path = \&fast_abs_path; + } } # package main; eval join('',) || die $@; # quick test diff --git a/contrib/perl5/lib/English.pm b/contrib/perl5/lib/English.pm index f6e3ec00215c..f38c313bebe2 100644 --- a/contrib/perl5/lib/English.pm +++ b/contrib/perl5/lib/English.pm @@ -98,6 +98,8 @@ sub import { *OSNAME *LAST_REGEXP_CODE_RESULT *EXCEPTIONS_BEING_CAUGHT + @LAST_MATCH_START + @LAST_MATCH_END ); # The ground of all being. @ARG is deprecated (5.005 makes @_ lexical) @@ -110,6 +112,8 @@ sub import { *PREMATCH = *` ; *POSTMATCH = *' ; *LAST_PAREN_MATCH = *+ ; + *LAST_MATCH_START = *-{ARRAY} ; + *LAST_MATCH_END = *+{ARRAY} ; # Input. diff --git a/contrib/perl5/lib/ExtUtils/Command.pm b/contrib/perl5/lib/ExtUtils/Command.pm index bccc76cc199d..aec4013d022a 100644 --- a/contrib/perl5/lib/ExtUtils/Command.pm +++ b/contrib/perl5/lib/ExtUtils/Command.pm @@ -177,7 +177,7 @@ Creates directory, including any parent directories. sub mkpath { - File::Path::mkpath([expand_wildcards()],1,0777); + File::Path::mkpath([expand_wildcards()],0,0777); } =item test_f file diff --git a/contrib/perl5/lib/ExtUtils/Embed.pm b/contrib/perl5/lib/ExtUtils/Embed.pm index b649b6b77b6d..98c24ac1cf25 100644 --- a/contrib/perl5/lib/ExtUtils/Embed.pm +++ b/contrib/perl5/lib/ExtUtils/Embed.pm @@ -6,6 +6,7 @@ require Exporter; require FileHandle; use Config; use Getopt::Std; +use File::Spec; #Only when we need them #require ExtUtils::MakeMaker; @@ -86,33 +87,8 @@ sub xsinit { sub xsi_header { return < #include -#ifdef PERL_OBJECT -#define NO_XSLOCKS -#include -#include "win32iop.h" -#include -#include -#endif -#ifdef is_cplusplus -} -# ifndef EXTERN_C -# define EXTERN_C extern "C" -# endif -#else -# ifndef EXTERN_C -# define EXTERN_C extern -# endif -#endif EOF } @@ -190,10 +166,14 @@ sub ldopts { } } $std = 1 unless scalar @link_args; - @path = $path ? split(/:/, $path) : @INC; + my $sep = $Config{path_sep} || ':'; + @path = $path ? split(/\Q$sep/, $path) : @INC; push(@potential_libs, @link_args) if scalar @link_args; - push(@potential_libs, $Config{libs}) if defined $std; + # makemaker includes std libs on windows by default + if ($^O ne 'MSWin32' and defined($std)) { + push(@potential_libs, $Config{perllibs}); + } push(@mods, static_ext()) if $std; @@ -223,12 +203,18 @@ sub ldopts { } #print STDERR "\@potential_libs = @potential_libs\n"; - my $libperl = (grep(/^-l\w*perl\w*$/, @link_args))[0] || "-lperl"; + my $libperl; + if ($^O eq 'MSWin32') { + $libperl = $Config{libperl}; + } + else { + $libperl = (grep(/^-l\w*perl\w*$/, @link_args))[0] || "-lperl"; + } + my $lpath = File::Spec->catdir($Config{archlibexp}, 'CORE'); + $lpath = qq["$lpath"] if $^O eq 'MSWin32'; my($extralibs, $bsloadlibs, $ldloadlibs, $ld_run_path) = - $MM->ext(join ' ', - $MM->catdir("-L$Config{archlibexp}", "CORE"), " $libperl", - @potential_libs); + $MM->ext(join ' ', "-L$lpath", $libperl, @potential_libs); my $ld_or_bs = $bsloadlibs || $ldloadlibs; print STDERR "bs: $bsloadlibs ** ld: $ldloadlibs" if $Verbose; @@ -248,7 +234,9 @@ sub ccdlflags { } sub perl_inc { - my_return(" -I$Config{archlibexp}/CORE "); + my $dir = File::Spec->catdir($Config{archlibexp}, 'CORE'); + $dir = qq["$dir"] if $^O eq 'MSWin32'; + my_return(" -I$dir "); } sub ccopts { @@ -277,6 +265,7 @@ ExtUtils::Embed - Utilities for embedding Perl in C/C++ applications perl -MExtUtils::Embed -e xsinit + perl -MExtUtils::Embed -e ccopts perl -MExtUtils::Embed -e ldopts =head1 DESCRIPTION @@ -484,7 +473,7 @@ B uses the xsi_* functions to generate most of it's code. =head1 EXAMPLES For examples on how to use B for building C/C++ applications -with embedded perl, see the eg/ directory and L. +with embedded perl, see L. =head1 SEE ALSO diff --git a/contrib/perl5/lib/ExtUtils/Install.pm b/contrib/perl5/lib/ExtUtils/Install.pm index 36c72219a94f..c496aa0ae500 100644 --- a/contrib/perl5/lib/ExtUtils/Install.pm +++ b/contrib/perl5/lib/ExtUtils/Install.pm @@ -16,6 +16,28 @@ my $splitchar = $^O eq 'VMS' ? '|' : ($^O eq 'os2' || $^O eq 'dos') ? ';' : ':'; my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || ''; my $Inc_uninstall_warn_handler; +# install relative to here + +my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT}; + +use File::Spec; + +sub install_rooted_file { + if (defined $INSTALL_ROOT) { + MY->catfile($INSTALL_ROOT, $_[0]); + } else { + $_[0]; + } +} + +sub install_rooted_dir { + if (defined $INSTALL_ROOT) { + MY->catdir($INSTALL_ROOT, $_[0]); + } else { + $_[0]; + } +} + #our(@EXPORT, @ISA, $Is_VMS); #use strict; @@ -55,8 +77,9 @@ sub install { opendir DIR, $source_dir_or_file or next; for (readdir DIR) { next if $_ eq "." || $_ eq ".." || $_ eq ".exists"; - if (-w $hash{$source_dir_or_file} || - mkpath($hash{$source_dir_or_file})) { + my $targetdir = install_rooted_dir($hash{$source_dir_or_file}); + if (-w $targetdir || + mkpath($targetdir)) { last; } else { warn "Warning: You do not have permissions to " . @@ -66,7 +89,8 @@ sub install { } closedir DIR; } - $packlist->read($pack{"read"}) if (-f $pack{"read"}); + my $tmpfile = install_rooted_file($pack{"read"}); + $packlist->read($tmpfile) if (-f $tmpfile); my $cwd = cwd(); my($source); @@ -80,11 +104,13 @@ sub install { #October 1997: we want to install .pm files into archlib if #there are any files in arch. So we depend on having ./blib/arch #hardcoded here. - my $targetroot = $hash{$source}; + + my $targetroot = install_rooted_dir($hash{$source}); + if ($source eq "blib/lib" and exists $hash{"blib/arch"} and directory_not_empty("blib/arch")) { - $targetroot = $hash{"blib/arch"}; + $targetroot = install_rooted_dir($hash{"blib/arch"}); print "Files found in blib/arch: installing files in blib/lib into architecture dependent library tree\n"; } chdir($source) or next; @@ -93,8 +119,9 @@ sub install { $atime,$mtime,$ctime,$blksize,$blocks) = stat; return unless -f _; return if $_ eq ".exists"; - my $targetdir = MY->catdir($targetroot,$File::Find::dir); - my $targetfile = MY->catfile($targetdir,$_); + my $targetdir = MY->catdir($targetroot, $File::Find::dir); + my $origfile = $_; + my $targetfile = MY->catfile($targetdir, $_); my $diff = 0; if ( -f $targetfile && -s _ == $size) { @@ -129,16 +156,16 @@ sub install { } else { inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0 } - $packlist->{$targetfile}++; + $packlist->{$origfile}++; }, "."); chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!"); } if ($pack{'write'}) { - $dir = dirname($pack{'write'}); + $dir = install_rooted_dir(dirname($pack{'write'})); mkpath($dir,0,0755); print "Writing $pack{'write'}\n"; - $packlist->write($pack{'write'}); + $packlist->write(install_rooted_file($pack{'write'})); } } @@ -235,8 +262,22 @@ sub inc_uninstall { } } +sub run_filter { + my ($cmd, $src, $dest) = @_; + local *SRC, *CMD; + open(CMD, "|$cmd >$dest") || die "Cannot fork: $!"; + open(SRC, $src) || die "Cannot open $src: $!"; + my $buf; + my $sz = 1024; + while (my $len = sysread(SRC, $buf, $sz)) { + syswrite(CMD, $buf, $len); + } + close SRC; + close CMD or die "Filter command '$cmd' failed for $src"; +} + sub pm_to_blib { - my($fromto,$autodir) = @_; + my($fromto,$autodir,$pm_filter) = @_; use File::Basename qw(dirname); use File::Copy qw(copy); @@ -259,23 +300,37 @@ sub pm_to_blib { mkpath($autodir,0,0755); foreach (keys %$fromto) { - next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_; - unless (compare($_,$fromto->{$_})){ - print "Skip $fromto->{$_} (unchanged)\n"; + my $dest = $fromto->{$_}; + next if -f $dest && -M $dest < -M $_; + + # When a pm_filter is defined, we need to pre-process the source first + # to determine whether it has changed or not. Therefore, only perform + # the comparison check when there's no filter to be ran. + # -- RAM, 03/01/2001 + + my $need_filtering = defined $pm_filter && length $pm_filter && /\.pm$/; + + if (!$need_filtering && 0 == compare($_,$dest)) { + print "Skip $dest (unchanged)\n"; next; } - if (-f $fromto->{$_}){ - forceunlink($fromto->{$_}); + if (-f $dest){ + forceunlink($dest); } else { - mkpath(dirname($fromto->{$_}),0,0755); + mkpath(dirname($dest),0,0755); + } + if ($need_filtering) { + run_filter($pm_filter, $_, $dest); + print "$pm_filter <$_ >$dest\n"; + } else { + copy($_,$dest); + print "cp $_ $dest\n"; } - copy($_,$fromto->{$_}); my($mode,$atime,$mtime) = (stat)[2,8,9]; - utime($atime,$mtime+$Is_VMS,$fromto->{$_}); - chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_}); - print "cp $_ $fromto->{$_}\n"; - next unless /\.pm\z/; - autosplit($fromto->{$_},$autodir); + utime($atime,$mtime+$Is_VMS,$dest); + chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$dest); + next unless /\.pm$/; + autosplit($dest,$autodir); } } @@ -289,18 +344,20 @@ sub add { } sub DESTROY { - my $self = shift; - my($file,$i,$plural); - foreach $file (sort keys %$self) { - $plural = @{$self->{$file}} > 1 ? "s" : ""; - print "## Differing version$plural of $file found. You might like to\n"; - for (0..$#{$self->{$file}}) { - print "rm ", $self->{$file}[$_], "\n"; - $i++; + unless(defined $INSTALL_ROOT) { + my $self = shift; + my($file,$i,$plural); + foreach $file (sort keys %$self) { + $plural = @{$self->{$file}} > 1 ? "s" : ""; + print "## Differing version$plural of $file found. You might like to\n"; + for (0..$#{$self->{$file}}) { + print "rm ", $self->{$file}[$_], "\n"; + $i++; + } + } + $plural = $i>1 ? "all those files" : "this file"; + print "## Running 'make install UNINST=1' will unlink $plural for you.\n"; } - } - $plural = $i>1 ? "all those files" : "this file"; - print "## Running 'make install UNINST=1' will unlink $plural for you.\n"; } 1; @@ -363,6 +420,11 @@ no-don't-really-do-it-now switch. pm_to_blib() takes a hashref as the first argument and copies all keys of the hash to the corresponding values efficiently. Filenames with the extension pm are autosplit. Second argument is the autosplit -directory. +directory. If third argument is not empty, it is taken as a filter command +to be ran on each .pm file, the output of the command being what is finally +copied, and the source for auto-splitting. + +You can have an environment variable PERL_INSTALL_ROOT set which will +be prepended as a directory to each installed file (and directory). =cut diff --git a/contrib/perl5/lib/ExtUtils/Liblist.pm b/contrib/perl5/lib/ExtUtils/Liblist.pm index 6029557f11eb..5e2f91db5cf9 100644 --- a/contrib/perl5/lib/ExtUtils/Liblist.pm +++ b/contrib/perl5/lib/ExtUtils/Liblist.pm @@ -1,9 +1,30 @@ package ExtUtils::Liblist; +@ISA = qw(ExtUtils::Liblist::Kid File::Spec); + +sub lsdir { + shift; + my $rex = qr/$_[1]/; + opendir my $dir, $_[0]; + grep /$rex/, readdir $dir; +} + +sub file_name_is_absolute { + require File::Spec; + shift; + 'File::Spec'->file_name_is_absolute(@_); +} + + +package ExtUtils::Liblist::Kid; + +# This kid package is to be used by MakeMaker. It will not work if +# $self is not a Makemaker. + use 5.005_64; # Broken out of MakeMaker from version 4.11 -our $VERSION = substr q$Revision: 1.25 $, 10; +our $VERSION = substr q$Revision: 1.26 $, 10; use Config; use Cwd 'cwd'; @@ -16,19 +37,19 @@ sub ext { } sub _unix_os2_ext { - my($self,$potential_libs, $verbose) = @_; - if ($^O =~ 'os2' and $Config{libs}) { + my($self,$potential_libs, $verbose, $give_libs) = @_; + if ($^O =~ 'os2' and $Config{perllibs}) { # Dynamic libraries are not transitive, so we may need including # the libraries linked against perl.dll again. $potential_libs .= " " if $potential_libs; - $potential_libs .= $Config{libs}; + $potential_libs .= $Config{perllibs}; } - return ("", "", "", "") unless $potential_libs; + return ("", "", "", "", ($give_libs ? [] : ())) unless $potential_libs; warn "Potential libraries are '$potential_libs':\n" if $verbose; my($so) = $Config{'so'}; - my($libs) = $Config{'libs'}; + my($libs) = $Config{'perllibs'}; my $Config_libext = $Config{lib_ext} || ".a"; @@ -39,6 +60,7 @@ sub _unix_os2_ext { my(@searchpath); # from "-L/path" entries in $potential_libs my(@libpath) = split " ", $Config{'libpth'}; my(@ldloadlibs, @bsloadlibs, @extralibs, @ld_run_path, %ld_run_path_seen); + my(@libs, %libs_seen); my($fullname, $thislib, $thispth, @fullname); my($pwd) = cwd(); # from Cwd.pm my($found) = 0; @@ -132,6 +154,7 @@ sub _unix_os2_ext { warn "'-l$thislib' found at $fullname\n" if $verbose; my($fullnamedir) = dirname($fullname); push @ld_run_path, $fullnamedir unless $ld_run_path_seen{$fullnamedir}++; + push @libs, $fullname unless $libs_seen{$fullname}++; $found++; $found_lib++; @@ -179,28 +202,29 @@ sub _unix_os2_ext { ."No library found for -l$thislib\n" unless $found_lib>0; } - return ('','','','') unless $found; - ("@extralibs", "@bsloadlibs", "@ldloadlibs",join(":",@ld_run_path)); + return ('','','','', ($give_libs ? \@libs : ())) unless $found; + ("@extralibs", "@bsloadlibs", "@ldloadlibs",join(":",@ld_run_path), ($give_libs ? \@libs : ())); } sub _win32_ext { require Text::ParseWords; - my($self, $potential_libs, $verbose) = @_; + my($self, $potential_libs, $verbose, $give_libs) = @_; # If user did not supply a list, we punt. # (caller should probably use the list in $Config{libs}) - return ("", "", "", "") unless $potential_libs; + return ("", "", "", "", ($give_libs ? [] : ())) unless $potential_libs; my $cc = $Config{cc}; my $VC = 1 if $cc =~ /^cl/i; my $BC = 1 if $cc =~ /^bcc/i; my $GC = 1 if $cc =~ /^gcc/i; my $so = $Config{'so'}; - my $libs = $Config{'libs'}; + my $libs = $Config{'perllibs'}; my $libpth = $Config{'libpth'}; my $libext = $Config{'lib_ext'} || ".lib"; + my(@libs, %libs_seen); if ($libs and $potential_libs !~ /:nodefault/i) { # If Config.pm defines a set of default libs, we always @@ -230,6 +254,10 @@ sub _win32_ext { # add "$Config{installarchlib}/CORE" to default search path push @libpath, "$Config{installarchlib}/CORE"; + if ($VC and exists $ENV{LIB} and $ENV{LIB}) { + push @libpath, split /;/, $ENV{LIB}; + } + foreach (Text::ParseWords::quotewords('\s+', 0, $potential_libs)){ $thislib = $_; @@ -294,6 +322,7 @@ sub _win32_ext { $found++; $found_lib++; push(@extralibs, $fullname); + push @libs, $fullname unless $libs_seen{$fullname}++; last; } @@ -315,10 +344,11 @@ sub _win32_ext { } - return ('','','','') unless $found; + return ('','','','', ($give_libs ? \@libs : ())) unless $found; # make sure paths with spaces are properly quoted @extralibs = map { (/\s/ && !/^".*"$/) ? qq["$_"] : $_ } @extralibs; + @libs = map { (/\s/ && !/^".*"$/) ? qq["$_"] : $_ } @libs; $lib = join(' ',@extralibs); # normalize back to backward slashes (to help braindead tools) @@ -327,18 +357,18 @@ sub _win32_ext { $lib =~ s,/,\\,g; warn "Result: $lib\n" if $verbose; - wantarray ? ($lib, '', $lib, '') : $lib; + wantarray ? ($lib, '', $lib, '', ($give_libs ? \@libs : ())) : $lib; } sub _vms_ext { - my($self, $potential_libs,$verbose) = @_; + my($self, $potential_libs,$verbose,$give_libs) = @_; my(@crtls,$crtlstr); my($dbgqual) = $self->{OPTIMIZE} || $Config{'optimize'} || $self->{CCFLAS} || $Config{'ccflags'}; @crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '') . 'PerlShr/Share' ); - push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libs'}); + push(@crtls, grep { not /\(/ } split /\s+/, $Config{'perllibs'}); push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libc'}); # In general, we pass through the basic libraries from %Config unchanged. # The one exception is that if we're building in the Perl source tree, and @@ -361,7 +391,7 @@ sub _vms_ext { unless ($potential_libs) { warn "Result:\n\tEXTRALIBS: \n\tLDLOADLIBS: $crtlstr\n" if $verbose; - return ('', '', $crtlstr, ''); + return ('', '', $crtlstr, '', ($give_libs ? [] : ())); } my(@dirs,@libs,$dir,$lib,%found,@fndlibs,$ldlib); @@ -370,6 +400,7 @@ sub _vms_ext { # List of common Unix library names and there VMS equivalents # (VMS equivalent of '' indicates that the library is automatially # searched by the linker, and should be skipped here.) + my(@flibs, %libs_seen); my %libmap = ( 'm' => '', 'f77' => '', 'F77' => '', 'V77' => '', 'c' => '', 'malloc' => '', 'crypt' => '', 'resolv' => '', 'c_s' => '', 'socket' => '', 'X11' => 'DECW$XLIBSHR', @@ -474,6 +505,7 @@ sub _vms_ext { if ($cand eq 'VAXCCURSE') { unshift @{$found{$ctype}}, $cand; } else { push @{$found{$ctype}}, $cand; } warn "\tFound as $cand (really $test), type $ctype\n" if $verbose > 1; + push @flibs, $name unless $libs_seen{$fullname}++; next LIB; } } @@ -488,7 +520,7 @@ sub _vms_ext { $ldlib = $crtlstr ? "$lib $crtlstr" : $lib; warn "Result:\n\tEXTRALIBS: $lib\n\tLDLOADLIBS: $ldlib\n" if $verbose; - wantarray ? ($lib, '', $ldlib, '') : $lib; + wantarray ? ($lib, '', $ldlib, '', ($give_libs ? \@flibs : ())) : $lib; } 1; @@ -503,20 +535,22 @@ ExtUtils::Liblist - determine libraries to use and how to use them C -C +C =head1 DESCRIPTION This utility takes a list of libraries in the form C<-llib1 -llib2 --llib3> and prints out lines suitable for inclusion in an extension +-llib3> and returns lines suitable for inclusion in an extension Makefile. Extra library paths may be included with the form C<-L/another/path> this will affect the searches for all subsequent libraries. -It returns an array of four scalar values: EXTRALIBS, BSLOADLIBS, -LDLOADLIBS, and LD_RUN_PATH. Some of these don't mean anything -on VMS and Win32. See the details about those platform specifics -below. +It returns an array of four or five scalar values: EXTRALIBS, +BSLOADLIBS, LDLOADLIBS, LD_RUN_PATH, and, optionally, a reference to +the array of the filenames of actual libraries. Some of these don't +mean anything unless on Unix. See the details about those platform +specifics below. The list of the filenames is returned only if +$need_names argument is true. Dependent libraries can be linked in one of three ways: @@ -624,7 +658,7 @@ Unix-OS/2 version in several respects: =item * If C<$potential_libs> is empty, the return value will be empty. -Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) +Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm) will be appended to the list of C<$potential_libs>. The libraries will be searched for in the directories specified in C<$potential_libs>, C<$Config{libpth}>, and in C<$Config{installarchlib}/CORE>. @@ -668,7 +702,7 @@ Entries in C<$potential_libs> beginning with a colon and followed by alphanumeric characters are treated as flags. Unknown flags will be ignored. An entry that matches C disables the appending of default -libraries found in C<$Config{libs}> (this should be only needed very rarely). +libraries found in C<$Config{perllibs}> (this should be only needed very rarely). An entry that matches C disables all searching for the libraries specified after it. Translation of C<-Lfoo> and @@ -678,7 +712,7 @@ valid files or directories. An entry that matches C reenables searching for the libraries specified after it. You can put it at the end to -enable searching for default libraries specified by C<$Config{libs}>. +enable searching for default libraries specified by C<$Config{perllibs}>. =item * diff --git a/contrib/perl5/lib/ExtUtils/MM_Cygwin.pm b/contrib/perl5/lib/ExtUtils/MM_Cygwin.pm index a5ba410fdc08..439c67ccadc5 100644 --- a/contrib/perl5/lib/ExtUtils/MM_Cygwin.pm +++ b/contrib/perl5/lib/ExtUtils/MM_Cygwin.pm @@ -71,6 +71,8 @@ q[-e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "], push(@m,"\n"); if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) { + grep { $self->{MAN1PODS}{$_} =~ s/::/./g } keys %{$self->{MAN1PODS}}; + grep { $self->{MAN3PODS}{$_} =~ s/::/./g } keys %{$self->{MAN3PODS}}; push @m, "\t$self->{NOECHO}\$(POD2MAN) \\\n\t"; push @m, join " \\\n\t", %{$self->{MAN1PODS}}, %{$self->{MAN3PODS}}; } diff --git a/contrib/perl5/lib/ExtUtils/MM_OS2.pm b/contrib/perl5/lib/ExtUtils/MM_OS2.pm index 430235a0aacf..cd6a1e4c49a1 100644 --- a/contrib/perl5/lib/ExtUtils/MM_OS2.pm +++ b/contrib/perl5/lib/ExtUtils/MM_OS2.pm @@ -93,6 +93,22 @@ sub perl_archive return "\$(PERL_INC)/libperl\$(LIB_EXT)"; } +=item perl_archive_after + +This is an internal method that returns path to a library which +should be put on the linker command line I the external libraries +to be linked to dynamic extensions. This may be needed if the linker +is one-pass, and Perl includes some overrides for C RTL functions, +such as malloc(). + +=cut + +sub perl_archive_after +{ + return "\$(PERL_INC)/libperl_override\$(LIB_EXT)" unless $OS2::is_aout; + return ""; +} + sub export_list { my ($self) = @_; diff --git a/contrib/perl5/lib/ExtUtils/MM_Unix.pm b/contrib/perl5/lib/ExtUtils/MM_Unix.pm index 4c8da339b87a..c11333d780f3 100644 --- a/contrib/perl5/lib/ExtUtils/MM_Unix.pm +++ b/contrib/perl5/lib/ExtUtils/MM_Unix.pm @@ -208,6 +208,7 @@ sub ExtUtils::MM_Unix::parse_version ; sub ExtUtils::MM_Unix::pasthru ; sub ExtUtils::MM_Unix::path ; sub ExtUtils::MM_Unix::perl_archive; +sub ExtUtils::MM_Unix::perl_archive_after; sub ExtUtils::MM_Unix::perl_script ; sub ExtUtils::MM_Unix::perldepend ; sub ExtUtils::MM_Unix::pm_to_blib ; @@ -305,8 +306,8 @@ sub cflags { $libperl ||= $self->{LIBPERL_A} || "libperl$self->{LIB_EXT}" ; $libperl =~ s/\.\$\(A\)$/$self->{LIB_EXT}/; - @cflags{qw(cc ccflags optimize large split shellflags)} - = @Config{qw(cc ccflags optimize large split shellflags)}; + @cflags{qw(cc ccflags optimize shellflags)} + = @Config{qw(cc ccflags optimize shellflags)}; my($optdebug) = ""; $cflags{shellflags} ||= ''; @@ -341,16 +342,12 @@ sub cflags { optimize=\"$cflags{optimize}\" perltype=\"$cflags{perltype}\" optdebug=\"$cflags{optdebug}\" - large=\"$cflags{large}\" - split=\"$cflags{'split'}\" eval '$prog' echo cc=\$cc echo ccflags=\$ccflags echo optimize=\$optimize echo perltype=\$perltype echo optdebug=\$optdebug - echo large=\$large - echo split=\$split `; my($line); foreach $line (@o){ @@ -368,7 +365,7 @@ sub cflags { $cflags{optimize} = $optdebug; } - for (qw(ccflags optimize perltype large split)) { + for (qw(ccflags optimize perltype)) { $cflags{$_} =~ s/^\s+//; $cflags{$_} =~ s/\s+/ /g; $cflags{$_} =~ s/\s+$//; @@ -411,8 +408,6 @@ sub cflags { CCFLAGS = $self->{CCFLAGS} OPTIMIZE = $self->{OPTIMIZE} PERLTYPE = $self->{PERLTYPE} -LARGE = $self->{LARGE} -SPLIT = $self->{SPLIT} MPOLLUTE = $pollute }; @@ -457,7 +452,7 @@ EOT push(@otherfiles, qw[./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all perlmain.c mon.out core core.*perl.*.? *perl.core so_locations pm_to_blib - *~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe + *$(OBJ_EXT) *$(LIB_EXT) perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp ]); @@ -483,7 +478,7 @@ sub const_cccmd { return '' unless $self->needs_linking(); return $self->{CONST_CCCMD} = q{CCCMD = $(CC) -c $(INC) $(CCFLAGS) $(OPTIMIZE) \\ - $(PERLTYPE) $(LARGE) $(SPLIT) $(MPOLLUTE) $(DEFINE_VERSION) \\ + $(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \\ $(XS_DEFINE_VERSION)}; } @@ -586,7 +581,7 @@ MM_VERSION = $ExtUtils::MakeMaker::VERSION for $tmp (qw/ FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT - LDFROM LINKTYPE + LDFROM LINKTYPE PM_FILTER / ) { next unless defined $self->{$tmp}; push @m, "$tmp = $self->{$tmp}\n"; @@ -679,6 +674,10 @@ EXPORT_LIST = $tmp $tmp = $self->perl_archive; push @m, " PERL_ARCHIVE = $tmp +"; + $tmp = $self->perl_archive_after; + push @m, " +PERL_ARCHIVE_AFTER = $tmp "; # push @m, q{ @@ -812,7 +811,7 @@ DIST_DEFAULT = $dist_default =item dist_basics (o) -Defines the targets distclean, distcheck, skipcheck, manifest. +Defines the targets distclean, distcheck, skipcheck, manifest, veryclean. =cut @@ -840,6 +839,11 @@ manifest : $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=mkmanifest \\ -e mkmanifest }; + + push @m, q{ +veryclean : realclean + $(RM_F) *~ *.orig */*~ */*.orig +}; join "", @m; } @@ -1062,7 +1066,7 @@ ARMAYBE = '.$armaybe.' OTHERLDFLAGS = '.$otherldflags.' INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' -$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) +$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP) '); if ($armaybe ne ':'){ $ldfrom = 'tmp$(LIB_EXT)'; @@ -1071,18 +1075,20 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists } $ldfrom = "-all $ldfrom -none" if ($^O eq 'dec_osf'); - # Brain dead solaris linker does not use LD_RUN_PATH? - # This fixes dynamic extensions which need shared libs - my $ldrun = ''; - $ldrun = join ' ', map "-R$_", split /:/, $self->{LD_RUN_PATH} - if ($^O eq 'solaris'); - - # The IRIX linker also doesn't use LD_RUN_PATH - $ldrun = qq{-rpath "$self->{LD_RUN_PATH}"} + # The IRIX linker doesn't use LD_RUN_PATH + my $ldrun = qq{-rpath "$self->{LD_RUN_PATH}"} if ($^O eq 'irix' && $self->{LD_RUN_PATH}); - push(@m,' LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ '.$ldrun.' $(LDDLFLAGS) '.$ldfrom. - ' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(EXPORT_LIST)'); + # For example in AIX the shared objects/libraries from previous builds + # linger quite a while in the shared dynalinker cache even when nobody + # is using them. This is painful if one for instance tries to restart + # a failed build because the link command will fail unnecessarily 'cos + # the shared object/library is 'busy'. + push(@m,' $(RM_F) $@ +'); + + push(@m,' LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) '.$ldrun.' $(LDDLFLAGS) '.$ldfrom. + ' $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST)'); push @m, ' $(CHMOD) $(PERM_RWX) $@ '; @@ -1147,9 +1153,9 @@ in these dirs: @$dirs "; } - foreach $dir (@$dirs){ - next unless defined $dir; # $self->{PERL_SRC} may be undefined - foreach $name (@$names){ + foreach $name (@$names){ + foreach $dir (@$dirs){ + next unless defined $dir; # $self->{PERL_SRC} may be undefined my ($abs, $val); if ($self->file_name_is_absolute($name)) { # /foo/bar $abs = $name; @@ -1249,11 +1255,6 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}' next; } my($dev,$ino,$mode) = stat FIXIN; - # If they override perm_rwx, we won't notice it during fixin, - # because fixin is run through a new instance of MakeMaker. - # That is why we must run another CHMOD later. - $mode = oct($self->perm_rwx) unless $dev; - chmod $mode, $file; # Print out the new #! line (or equivalent). local $\; @@ -1261,7 +1262,15 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}' print FIXOUT $shb, ; close FIXIN; close FIXOUT; - # can't rename open files on some DOSISH platforms + + # can't rename/chmod open files on some DOSISH platforms + + # If they override perm_rwx, we won't notice it during fixin, + # because fixin is run through a new instance of MakeMaker. + # That is why we must run another CHMOD later. + $mode = oct($self->perm_rwx) unless $dev; + chmod $mode, $file; + unless ( rename($file, "$file.bak") ) { warn "Can't rename $file to $file.bak: $!"; next; @@ -1276,6 +1285,7 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}' } unlink "$file.bak"; } continue { + close(FIXIN) if fileno(FIXIN); chmod oct($self->perm_rwx), $file or die "Can't reset permissions for $file: $!\n"; system("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';; @@ -1653,7 +1663,7 @@ sub init_main { unless ($self->{PERL_SRC}){ my($dir); - foreach $dir ($self->updir(),$self->catdir($self->updir(),$self->updir()),$self->catdir($self->updir(),$self->updir(),$self->updir())){ + foreach $dir ($self->updir(),$self->catdir($self->updir(),$self->updir()),$self->catdir($self->updir(),$self->updir(),$self->updir()),$self->catdir($self->updir(),$self->updir(),$self->updir(),$self->updir())){ if ( -f $self->catfile($dir,"config.sh") && @@ -2367,7 +2377,7 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) # The front matter of the linkcommand... $linkcmd = join ' ', "\$(CC)", - grep($_, @Config{qw(large split ldflags ccdlflags)}); + grep($_, @Config{qw(ldflags ccdlflags)}); $linkcmd =~ s/\s+/ /g; $linkcmd =~ s,(perl\.exp),\$(PERL_INC)/$1,; @@ -2450,7 +2460,7 @@ MAP_PERLINC = @{$perlinc || []} MAP_STATIC = ", join(" \\\n\t", reverse sort keys %static), " -MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib} +MAP_PRELIBS = $Config::Config{perllibs} $Config::Config{cryptlib} "; if (defined $libperl) { @@ -2458,6 +2468,7 @@ MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib} } unless ($libperl && -f $lperl) { # Ilya's code... my $dir = $self->{PERL_SRC} || "$self->{PERL_ARCHLIB}/CORE"; + $dir = "$self->{PERL_ARCHLIB}/.." if $self->{UNINSTALLED_PERL}; $libperl ||= "libperl$self->{LIB_EXT}"; $libperl = "$dir/$libperl"; $lperl ||= "libperl$self->{LIB_EXT}"; @@ -2495,14 +2506,9 @@ MAP_LIBPERL = $libperl # SUNOS ld does not take the full path to a shared library my $llibperl = ($libperl)?'$(MAP_LIBPERL)':'-lperl'; - # Brain dead solaris linker does not use LD_RUN_PATH? - # This fixes dynamic extensions which need shared libs - my $ldfrom = ($^O eq 'solaris')? - join(' ', map "-R$_", split /:/, $self->{LD_RUN_PATH}):''; - push @m, " \$(MAP_TARGET) :: $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all - \$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) $ldfrom \$(MAP_STATIC) $llibperl `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS) + \$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) \$(LDFROM) \$(MAP_STATIC) $llibperl `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS) $self->{NOECHO}echo 'To install the new \"\$(MAP_TARGET)\" binary, call' $self->{NOECHO}echo ' make -f $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)' $self->{NOECHO}echo 'To remove the intermediate files say' @@ -3038,7 +3044,7 @@ sub pm_to_blib { pm_to_blib: $(TO_INST_PM) }.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \ "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \ - -e "pm_to_blib({qw{$(PM_TO_BLIB)}},'}.$autodir.q{')" + -e "pm_to_blib({qw{$(PM_TO_BLIB)}},'}.$autodir.q{','$(PM_FILTER)')" }.$self->{NOECHO}.q{$(TOUCH) $@ }; } @@ -3110,6 +3116,7 @@ sub processPL { my $list = ref($self->{PL_FILES}->{$plfile}) ? $self->{PL_FILES}->{$plfile} : [$self->{PL_FILES}->{$plfile}]; + my $target; foreach $target (@$list) { push @m, " all :: $target @@ -3149,8 +3156,22 @@ realclean purge :: clean push(@m, " $self->{RM_F} \$(INST_DYNAMIC) \$(INST_BOOT)\n"); push(@m, " $self->{RM_F} \$(INST_STATIC)\n"); } - push(@m, " $self->{RM_F} " . join(" ", values %{$self->{PM}}) . "\n") - if keys %{$self->{PM}}; + # Issue a several little RM_F commands rather than risk creating a + # very long command line (useful for extensions such as Encode + # that have many files). + if (keys %{$self->{PM}}) { + my $line = ""; + foreach (values %{$self->{PM}}) { + if (length($line) + length($_) > 80) { + push @m, "\t$self->{RM_F} $line\n"; + $line = $_; + } + else { + $line .= " $_"; + } + } + push @m, "\t$self->{RM_F} $line\n" if $line; + } my(@otherfiles) = ($self->{MAKEFILE}, "$self->{MAKEFILE}.old"); # Makefiles last push(@otherfiles, $attribs{FILES}) if $attribs{FILES}; @@ -3169,9 +3190,11 @@ form Foo/Bar and replaces the slash with C<::>. Returns the replacement. sub replace_manpage_separator { my($self,$man) = @_; if ($^O eq 'uwin') { - $man =~ s,/+,.,g; + $man =~ s,/+,.,g; + } elsif ($Is_Dos) { + $man =~ s,/+,__,g; } else { - $man =~ s,/+,::,g; + $man =~ s,/+,::,g; } $man; } @@ -3490,13 +3513,13 @@ WARN_IF_OLD_PACKLIST = $(PERL) -we 'exit unless -f $$ARGV[0];' \\ -e 'print "Please make sure the two installations are not conflicting\n";' UNINST=0 -VERBINST=1 +VERBINST=0 MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \ -e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');" DOC_INSTALL = $(PERL) -e '$$\="\n\n";' \ --e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", shift, ">";' \ +-e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", $$arg=shift, "|", $$arg, ">";' \ -e 'print "=over 4";' \ -e 'while (defined($$key = shift) and defined($$val = shift)){print "=item *";print "C<$$key: $$val>";}' \ -e 'print "=back";' @@ -3791,6 +3814,21 @@ sub perl_archive return ""; } +=item perl_archive_after + +This is an internal method that returns path to a library which +should be put on the linker command line I the external libraries +to be linked to dynamic extensions. This may be needed if the linker +is one-pass, and Perl includes some overrides for C RTL functions, +such as malloc(). + +=cut + +sub perl_archive_after +{ + return ""; +} + =item export_list This is internal method that returns name of a file that is diff --git a/contrib/perl5/lib/ExtUtils/MM_VMS.pm b/contrib/perl5/lib/ExtUtils/MM_VMS.pm index 57a8146dae75..7b75958e8937 100644 --- a/contrib/perl5/lib/ExtUtils/MM_VMS.pm +++ b/contrib/perl5/lib/ExtUtils/MM_VMS.pm @@ -151,11 +151,12 @@ sub AUTOLOAD { # This isn't really an override. It's just here because ExtUtils::MM_VMS -# appears in @MM::ISA before ExtUtils::Liblist, so if there isn't an ext() +# appears in @MM::ISA before ExtUtils::Liblist::Kid, so if there isn't an ext() # in MM_VMS, then AUTOLOAD is called, and bad things happen. So, we just -# mimic inheritance here and hand off to ExtUtils::Liblist. +# mimic inheritance here and hand off to ExtUtils::Liblist::Kid. sub ext { - ExtUtils::Liblist::ext(@_); + require ExtUtils::Liblist; + ExtUtils::Liblist::Kid::ext(@_); } =back @@ -231,7 +232,9 @@ invoke Perl images. sub find_perl { my($self, $ver, $names, $dirs, $trace) = @_; my($name,$dir,$vmsfile,@sdirs,@snames,@cand); + my($rslt); my($inabs) = 0; + local *TCF; # Check in relative directories first, so we pick up the current # version of Perl if we're running MakeMaker as part of the main build. @sdirs = sort { my($absa) = $self->file_name_is_absolute($a); @@ -277,15 +280,28 @@ sub find_perl { foreach $name (@cand) { print "Checking $name\n" if ($trace >= 2); # If it looks like a potential command, try it without the MCR - if ($name =~ /^[\w\-\$]+$/ && - `$name -e "require $ver; print ""VER_OK\\n"""` =~ /VER_OK/) { + if ($name =~ /^[\w\-\$]+$/) { + open(TCF,">temp_mmvms.com") || die('unable to open temp file'); + print TCF "\$ set message/nofacil/nosever/noident/notext\n"; + print TCF "\$ $name -e \"require $ver; print \"\"VER_OK\\n\"\"\"\n"; + close TCF; + $rslt = `\@temp_mmvms.com` ; + unlink('temp_mmvms.com'); + if ($rslt =~ /VER_OK/) { print "Using PERL=$name\n" if $trace; return $name; } + } next unless $vmsfile = $self->maybe_command($name); $vmsfile =~ s/;[\d\-]*$//; # Clip off version number; we can use a newer version as well print "Executing $vmsfile\n" if ($trace >= 2); - if (`MCR $vmsfile -e "require $ver; print ""VER_OK\\n"""` =~ /VER_OK/) { + open(TCF,">temp_mmvms.com") || die('unable to open temp file'); + print TCF "\$ set message/nofacil/nosever/noident/notext\n"; + print TCF "\$ mcr $vmsfile -e \"require $ver; print \"\"VER_OK\\n\"\"\" \n"; + close TCF; + $rslt = `\@temp_mmvms.com`; + unlink('temp_mmvms.com'); + if ($rslt =~ /VER_OK/) { print "Using PERL=MCR $vmsfile\n" if $trace; return "MCR $vmsfile"; } @@ -611,7 +627,7 @@ INST_ARCHAUTODIR = $self->{INST_ARCHAUTODIR} if ($self->has_link_code()) { push @m,' INST_STATIC = $(INST_ARCHAUTODIR)$(BASEEXT)$(LIB_EXT) -INST_DYNAMIC = $(INST_ARCHAUTODIR)$(BASEEXT).$(DLEXT) +INST_DYNAMIC = $(INST_ARCHAUTODIR)$(DLBASE).$(DLEXT) INST_BOOT = $(INST_ARCHAUTODIR)$(BASEEXT).bs '; } else { @@ -811,7 +827,7 @@ pm_to_blib.ts : $(TO_INST_PM) } push(@m,"\t\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n") if $line; - push(@m,q[ $(PERL) "-I$(PERL_LIB)" "-MExtUtils::Install" -e "pm_to_blib({split(' ',)},'].$autodir.q[')" <.MM_tmp]); + push(@m,q[ $(PERL) "-I$(PERL_LIB)" "-MExtUtils::Install" -e "pm_to_blib({split(' ',)},'].$autodir.q[','$(PM_FILTER)')" <.MM_tmp]); push(@m,qq[ \$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp; \$(NOECHO) \$(TOUCH) pm_to_blib.ts @@ -866,6 +882,11 @@ sub tool_xsubpp { unshift( @tmargs, $self->{XSOPT} ); } + if ($Config{'ldflags'} && + $Config{'ldflags'} =~ m!/Debug!i && + (!exists($self->{XSOPT}) || $self->{XSOPT} !~ /linenumbers/)) { + unshift(@tmargs,'-nolinenumbers'); + } my $xsubpp_version = $self->xsubpp_version($self->catfile($xsdir,'xsubpp')); # What are the correct thresholds for version 1 && 2 Paul? @@ -1018,7 +1039,7 @@ sub dist { # Sanitize these for use in $(DISTVNAME) filespec $attribs{VERSION} =~ s/[^\w\$]/_/g; - $attribs{NAME} =~ s/[^\w\$]/_/g; + $attribs{NAME} =~ s/[^\w\$]/-/g; return ExtUtils::MM_Unix::dist($self,%attribs); } @@ -1194,8 +1215,8 @@ $(BASEEXT).opt : Makefile.PL s/.*[:>\/\]]//; # Trim off dir spec $upcase ? uc($_) : $_; } split ' ', $self->eliminate_macros($self->{OBJECT}); - my($tmp,@lines,$elt) = ''; - my $tmp = shift @omods; + my($tmp,@lines,$elt) = ''; + $tmp = shift @omods; foreach $elt (@omods) { $tmp .= ",$elt"; if (length($tmp) > 80) { push @lines, $tmp; $tmp = ''; } @@ -1652,6 +1673,9 @@ dist : $(DIST_DEFAULT) zipdist : $(DISTVNAME).zip $(NOECHO) $(NOOP) +tardist : $(DISTVNAME).tar$(SUFFIX) + $(NOECHO) $(NOOP) + $(DISTVNAME).zip : distdir $(PREOP) $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*; @@ -1661,7 +1685,7 @@ $(DISTVNAME).zip : distdir $(DISTVNAME).tar$(SUFFIX) : distdir $(PREOP) $(TO_UNIX) - $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)] + $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)...] $(RM_RF) $(DISTVNAME) $(COMPRESS) $(DISTVNAME).tar $(POSTOP) @@ -1872,6 +1896,7 @@ $(OBJECT) : $(PERL_INC)iperlsys.h # We do NOT just update config.h because that is not sufficient. # An out of date config.h is not fatal but complains loudly! $(PERL_INC)config.h : $(PERL_SRC)config.sh + $(NOOP) $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.h or genconfig.pl" diff --git a/contrib/perl5/lib/ExtUtils/MM_Win32.pm b/contrib/perl5/lib/ExtUtils/MM_Win32.pm index e08c6791eee4..5361ecee9935 100644 --- a/contrib/perl5/lib/ExtUtils/MM_Win32.pm +++ b/contrib/perl5/lib/ExtUtils/MM_Win32.pm @@ -596,7 +596,7 @@ pm_to_blib: $(TO_INST_PM) ($NMAKE ? 'qw[ <', ' L<', shift, '>';" \ +-e "print '=head2 ', scalar(localtime), ': C<', shift, '>', ' L<', $$arg=shift, '|', $$arg, '>';" \ -e "print '=over 4';" \ -e "while (defined($$key = shift) and defined($$val = shift)) { print '=item *';print 'C<', \"$$key: $$val\", '>'; }" \ -e "print '=back';" diff --git a/contrib/perl5/lib/ExtUtils/MakeMaker.pm b/contrib/perl5/lib/ExtUtils/MakeMaker.pm index 38cb2169a338..8bf76c731341 100644 --- a/contrib/perl5/lib/ExtUtils/MakeMaker.pm +++ b/contrib/perl5/lib/ExtUtils/MakeMaker.pm @@ -44,7 +44,7 @@ use vars qw( # default routine without having to know under what OS # it's running. # -@MM::ISA = qw[ExtUtils::MM_Unix ExtUtils::Liblist ExtUtils::MakeMaker]; +@MM::ISA = qw[ExtUtils::MM_Unix ExtUtils::Liblist::Kid ExtUtils::MakeMaker]; # # Setup dummy package: @@ -60,7 +60,7 @@ use vars qw( # "predeclare the package: we only load it via AUTOLOAD # but we have already mentioned it in @ISA -package ExtUtils::Liblist; +package ExtUtils::Liblist::Kid; package ExtUtils::MakeMaker; # @@ -82,7 +82,7 @@ if ($Is_OS2) { require ExtUtils::MM_OS2; } if ($Is_Mac) { - require ExtUtils::MM_Mac; + require ExtUtils::MM_MacOS; } if ($Is_Win32) { require ExtUtils::MM_Win32; @@ -189,7 +189,7 @@ sub full_setup { AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION C CAPI CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS EXCLUDE_EXT EXE_FILES FIRST_MAKEFILE FULLPERL FUNCLIST H - HTMLLIBPODS HTMLSCRIPTPOD IMPORTS + HTMLLIBPODS HTMLSCRIPTPODS IMPORTS INC INCLUDE_EXT INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLHTMLPRIVLIBDIR INSTALLHTMLSCRIPTDIR INSTALLHTMLSITELIBDIR INSTALLMAN1DIR INSTALLMAN3DIR INSTALLPRIVLIB INSTALLSCRIPT INSTALLSITEARCH @@ -200,10 +200,14 @@ sub full_setup { PERL_MALLOC_OK NAME NEEDS_LINKING NOECHO NORECURS NO_VC OBJECT OPTIMIZE PERL PERLMAINCC PERL_ARCHLIB PERL_LIB PERL_SRC PERM_RW PERM_RWX - PL_FILES PM PMLIBDIRS POLLUTE PPM_INSTALL_EXEC PPM_INSTALL_SCRIPT PREFIX + PL_FILES PM PM_FILTER PMLIBDIRS POLLUTE PPM_INSTALL_EXEC + PPM_INSTALL_SCRIPT PREFIX PREREQ_PM SKIP 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 /; # IMPORTS is used under OS/2 and Win32 @@ -239,7 +243,6 @@ sub full_setup { dir_target libscan makeaperl needs_linking perm_rw perm_rwx subdir_x test_via_harness test_via_script - ]; push @MM_Sections, qw[ @@ -982,23 +985,39 @@ be perl Makefile.PL LIB=~/lib This will install the module's architecture-independent files into -~/lib, the architecture-dependent files into ~/lib/$archname/auto. +~/lib, the architecture-dependent files into ~/lib/$archname. Another way to specify many INSTALL directories with a single parameter is PREFIX. perl Makefile.PL PREFIX=~ -This will replace the string specified by $Config{prefix} in all -$Config{install*} values. +This will replace the string specified by C<$Config{prefix}> in all +C<$Config{install*}> values. Note, that in both cases the tilde expansion is done by MakeMaker, not -by perl by default, nor by make. Conflicts between parameters LIB, -PREFIX and the various INSTALL* arguments are resolved so that -XXX +by perl by default, nor by make. + +Conflicts between parameters LIB, +PREFIX and the various INSTALL* arguments are resolved so that: + +=over 4 + +=item * + +setting LIB overrides any setting of INSTALLPRIVLIB, INSTALLARCHLIB, +INSTALLSITELIB, INSTALLSITEARCH (and they are not affected by PREFIX); + +=item * + +without LIB, setting PREFIX replaces the initial C<$Config{prefix}> +part of those INSTALL* arguments, even if the latter are explicitly +set (but are set to still start with C<$Config{prefix}>). + +=back If the user has superuser privileges, and is not working on AFS -(Andrew File System) or relatives, then the defaults for +or relatives, then the defaults for INSTALLPRIVLIB, INSTALLARCHLIB, INSTALLSCRIPT, etc. will be appropriate, and this incantation will be the best: @@ -1145,11 +1164,6 @@ or as NAME=VALUE pairs on the command line: =over 2 -=item AUTHOR - -String containing name (and email address) of package author(s). Is used -in PPD (Perl Package Description) files for PPM (Perl Package Manager). - =item ABSTRACT One line description of the module. Will be included in PPD file. @@ -1160,6 +1174,11 @@ Name of the file that contains the package description. MakeMaker looks for a line in the POD matching /^($package\s-\s)(.*)/. This is typically the first line in the "=head1 NAME" section. $2 becomes the abstract. +=item AUTHOR + +String containing name (and email address) of package author(s). Is used +in PPD (Perl Package Description) files for PPM (Perl Package Manager). + =item BINARY_LOCATION Used when creating PPD files for binary packages. It can be set to a @@ -1409,11 +1428,6 @@ to INSTALLBIN during 'make install' Old name for INST_SCRIPT. Deprecated. Please use INST_SCRIPT if you need to use it. -=item INST_LIB - -Directory where we put library files of this extension while building -it. - =item INST_HTMLLIBDIR Directory to hold the man pages in HTML format at 'make' time @@ -1422,6 +1436,11 @@ Directory to hold the man pages in HTML format at 'make' time Directory to hold the man pages in HTML format at 'make' time +=item INST_LIB + +Directory where we put library files of this extension while building +it. + =item INST_MAN1DIR Directory to hold the man pages at 'make' time @@ -1437,34 +1456,6 @@ Directory, where executable files should be installed during testing. make install will copy the files in INST_SCRIPT to INSTALLSCRIPT. -=item PERL_MALLOC_OK - -defaults to 0. Should be set to TRUE if the extension can work with -the memory allocation routines substituted by the Perl malloc() subsystem. -This should be applicable to most extensions with exceptions of those - -=over - -=item * - -with bugs in memory allocations which are caught by Perl's malloc(); - -=item * - -which interact with the memory allocator in other ways than via -malloc(), realloc(), free(), calloc(), sbrk() and brk(); - -=item * - -which rely on special alignment which is not provided by Perl's malloc(). - -=back - -B Negligence to set this flag in I of loaded extension -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 LDFROM defaults to "$(OBJECT)" and is used in the ld command to specify @@ -1473,8 +1464,12 @@ specify ld flags) =item LIB -LIB can only be set at C time. It has the effect of +LIB should only be set at C time but is allowed as a +MakeMaker argument. It has the effect of setting both INSTALLPRIVLIB and INSTALLSITELIB to that value regardless any +explicit setting of those arguments (or of PREFIX). +INSTALLARCHLIB and INSTALLSITEARCH are set to the corresponding +architecture subdirectory. =item LIBPERL_A @@ -1578,6 +1573,8 @@ List of object files, defaults to '$(BASEEXT)$(OBJ_EXT)', but can be a long string containing all object files, e.g. "tkpBind.o tkpButton.o tkpCanvas.o" +(Where BASEEXT is the last component of NAME, and OBJ_EXT is $Config{obj_ext}.) + =item OPTIMIZE Defaults to C<-O>. Set it to C<-g> to turn debugging on. The flag is @@ -1594,12 +1591,40 @@ to $(CC). =item PERL_ARCHLIB -Same as above for architecture dependent files. +Same as below, but for architecture dependent files. =item PERL_LIB Directory containing the Perl library to use. +=item PERL_MALLOC_OK + +defaults to 0. Should be set to TRUE if the extension can work with +the memory allocation routines substituted by the Perl malloc() subsystem. +This should be applicable to most extensions with exceptions of those + +=over 4 + +=item * + +with bugs in memory allocations which are caught by Perl's malloc(); + +=item * + +which interact with the memory allocator in other ways than via +malloc(), realloc(), free(), calloc(), sbrk() and brk(); + +=item * + +which rely on special alignment which is not provided by Perl's malloc(). + +=back + +B Negligence to set this flag in I of loaded extension +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 PERL_SRC Directory containing the Perl source code (use of this should be @@ -1648,6 +1673,31 @@ they contain will be installed in the corresponding location in the library. A libscan() method can be used to alter the behaviour. Defining PM in the Makefile.PL will override PMLIBDIRS. +(Where BASEEXT is the last component of NAME.) + +=item PM_FILTER + +A filter program, in the traditional Unix sense (input from stdin, output +to stdout) that is passed on each .pm file during the build (in the +pm_to_blib() phase). It is empty by default, meaning no filtering is done. + +Great care is necessary when defining the command if quoting needs to be +done. For instance, you would need to say: + + {'PM_FILTER' => 'grep -v \\"^\\#\\"'} + +to remove all the leading coments on the fly during the build. The +extra \\ are necessary, unfortunately, because this variable is interpolated +within the context of a Perl program built on the command line, and double +quotes are what is used with the -e switch to build that command line. The +# is escaped for the Makefile, since what is going to be generated will then +be: + + PM_FILTER = grep -v \"^\#\" + +Without the \\ before the #, we'd have the start of a Makefile comment, +and the macro would be incorrectly defined. + =item POLLUTE Release 5.005 grandfathered old global symbol names by providing preprocessor @@ -1725,6 +1775,7 @@ MakeMaker object. The following lines will be parsed o.k.: ( $VERSION ) = '$Revision: 1.222 $ ' =~ /\$Revision:\s+([^\s]+)/; $FOO::VERSION = '1.10'; *FOO::VERSION = \'1.11'; + our $VERSION = 1.2.3; # new for perl5.6.0 but these will fail: @@ -1732,6 +1783,8 @@ but these will fail: local $VERSION = '1.02'; local $FOO::VERSION = '1.30'; +(Putting C or C on the preceding line will work o.k.) + The file named in VERSION_FROM is not added as a dependency to Makefile. This is not really correct, but it would be a major pain during development to have to rewrite the Makefile for any smallish @@ -1786,6 +1839,8 @@ part of the Makefile. {ANY_TARGET => ANY_DEPENDECY, ...} +(ANY_TARGET must not be given a double-colon rule by MakeMaker.) + =item dist {TARFLAGS => 'cvfF', COMPRESS => 'gzip', SUFFIX => '.gz', diff --git a/contrib/perl5/lib/ExtUtils/Manifest.pm b/contrib/perl5/lib/ExtUtils/Manifest.pm index 8bb3fc8ebd6e..50a426336122 100644 --- a/contrib/perl5/lib/ExtUtils/Manifest.pm +++ b/contrib/perl5/lib/ExtUtils/Manifest.pm @@ -8,13 +8,14 @@ use Carp; use strict; use vars qw($VERSION @ISA @EXPORT_OK - $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found); + $Is_MacOS $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found); $VERSION = substr(q$Revision: 1.33 $, 10); @ISA=('Exporter'); @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 'skipcheck', 'maniread', 'manicopy'); +$Is_MacOS = $^O eq 'MacOS'; $Is_VMS = $^O eq 'VMS'; if ($Is_VMS) { require File::Basename } @@ -49,6 +50,7 @@ sub mkmanifest { } my $text = $all{$file}; ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text; + $file = _unmacify($file); my $tabs = (5 - (length($file)+1)/8); $tabs = 1 if $tabs < 1; $tabs = 0 unless $text; @@ -60,10 +62,11 @@ sub mkmanifest { sub manifind { local $found = {}; find(sub {return if -d $_; - (my $name = $File::Find::name) =~ s|./||; + (my $name = $File::Find::name) =~ s|^\./||; + $name =~ s/^:([^:]+)$/$1/ if $Is_MacOS; warn "Debug: diskfile $name\n" if $Debug; - $name =~ s#(.*)\.$#\L$1# if $Is_VMS; - $found->{$name} = "";}, "."); + $name =~ s#(.*)\.$#\L$1# if $Is_VMS; + $found->{$name} = "";}, $Is_MacOS ? ":" : "."); $found; } @@ -115,7 +118,8 @@ sub _manicheck { } warn "Debug: manicheck checking from disk $file\n" if $Debug; unless ( exists $read->{$file} ) { - warn "Not in $MANIFEST: $file\n" unless $Quiet; + my $canon = "\t" . _unmacify($file) if $Is_MacOS; + warn "Not in $MANIFEST: $file$canon\n" unless $Quiet; push @missentry, $file; } } @@ -135,7 +139,13 @@ sub maniread { while (){ chomp; next if /^#/; - if ($Is_VMS) { + if ($Is_MacOS) { + my($item,$text) = /^(\S+)\s*(.*)/; + $item = _macify($item); + $item =~ s/\\([0-3][0-7][0-7])/sprintf("%c", oct($1))/ge; + $read->{$item}=$text; + } + elsif ($Is_VMS) { my($file)= /^(\S+)/; next unless $file; my($base,$dir) = File::Basename::fileparse($file); @@ -166,7 +176,7 @@ sub _maniskip { chomp; next if /^#/; next if /^\s*$/; - push @skip, $_; + push @skip, _macify($_); } close M; my $opts = $Is_VMS ? 'oi ' : 'o '; @@ -187,15 +197,24 @@ sub manicopy { require File::Basename; my(%dirs,$file); $target = VMS::Filespec::unixify($target) if $Is_VMS; - File::Path::mkpath([ $target ],1,$Is_VMS ? undef : 0755); + File::Path::mkpath([ $target ],! $Quiet,$Is_VMS ? undef : 0755); foreach $file (keys %$read){ - $file = VMS::Filespec::unixify($file) if $Is_VMS; - if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not? - my $dir = File::Basename::dirname($file); - $dir = VMS::Filespec::unixify($dir) if $Is_VMS; - File::Path::mkpath(["$target/$dir"],1,$Is_VMS ? undef : 0755); + if ($Is_MacOS) { + if ($file =~ m!:!) { + my $dir = _maccat($target, $file); + $dir =~ s/[^:]+$//; + File::Path::mkpath($dir,1,0755); + } + cp_if_diff($file, _maccat($target, $file), $how); + } else { + $file = VMS::Filespec::unixify($file) if $Is_VMS; + if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not? + my $dir = File::Basename::dirname($file); + $dir = VMS::Filespec::unixify($dir) if $Is_VMS; + File::Path::mkpath(["$target/$dir"],! $Quiet,$Is_VMS ? undef : 0755); + } + cp_if_diff($file, "$target/$file", $how); } - cp_if_diff($file, "$target/$file", $how); } } @@ -204,8 +223,8 @@ sub cp_if_diff { -f $from or carp "$0: $from not found"; my($diff) = 0; local(*F,*T); - open(F,$from) or croak "Can't read $from: $!\n"; - if (open(T,$to)) { + open(F,"< $from\0") or croak "Can't read $from: $!\n"; + if (open(T,"< $to\0")) { while () { $diff++,last if $_ ne ; } $diff++ unless eof(T); close T; @@ -233,12 +252,12 @@ sub cp { copy($srcFile,$dstFile); utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile; # chmod a+rX-w,go-w - chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile ); + chmod( 0444 | ( $perm & 0111 ? 0111 : 0 ), $dstFile ) unless ($^O eq 'MacOS'); } sub ln { my ($srcFile, $dstFile) = @_; - return &cp if $Is_VMS; + return &cp if $Is_VMS or ($^O eq 'MSWin32' and Win32::IsWin95()); link($srcFile, $dstFile); local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x) my $mode= 0444 | (stat)[2] & 0700; @@ -258,6 +277,42 @@ sub best { } } +sub _macify { + my($file) = @_; + + return $file unless $Is_MacOS; + + $file =~ s|^\./||; + if ($file =~ m|/|) { + $file =~ s|/+|:|g; + $file = ":$file"; + } + + $file; +} + +sub _maccat { + my($f1, $f2) = @_; + + return "$f1/$f2" unless $Is_MacOS; + + $f1 .= ":$f2"; + $f1 =~ s/([^:]:):/$1/g; + return $f1; +} + +sub _unmacify { + my($file) = @_; + + return $file unless $Is_MacOS; + + $file =~ s|^:||; + $file =~ s|([/ \n])|sprintf("\\%03o", unpack("c", $1))|ge; + $file =~ y|:|/|; + + $file; +} + 1; __END__ diff --git a/contrib/perl5/lib/ExtUtils/Mksymlists.pm b/contrib/perl5/lib/ExtUtils/Mksymlists.pm index c8f41c74bcd7..c06b393be353 100644 --- a/contrib/perl5/lib/ExtUtils/Mksymlists.pm +++ b/contrib/perl5/lib/ExtUtils/Mksymlists.pm @@ -49,6 +49,7 @@ sub Mksymlists { } if ($osname eq 'aix') { _write_aix(\%spec); } + elsif ($osname eq 'MacOS'){ _write_aix(\%spec) } elsif ($osname eq 'VMS') { _write_vms(\%spec) } elsif ($osname eq 'os2') { _write_os2(\%spec) } elsif ($osname eq 'MSWin32') { _write_win32(\%spec) } diff --git a/contrib/perl5/lib/ExtUtils/typemap b/contrib/perl5/lib/ExtUtils/typemap index a34cd4f9ea77..c309128fc324 100644 --- a/contrib/perl5/lib/ExtUtils/typemap +++ b/contrib/perl5/lib/ExtUtils/typemap @@ -1,4 +1,3 @@ -# $Header: /home/rmb1/misc/CVS/perl5.005_61/lib/ExtUtils/typemap,v 1.3 1999/09/13 09:46:43 rmb1 Exp $ # basic C types int T_IV unsigned T_UV @@ -30,6 +29,7 @@ CV * T_CVREF IV T_IV UV T_UV +NV T_NV I32 T_IV I16 T_IV I8 T_IV @@ -226,13 +226,13 @@ T_U_CHAR T_FLOAT sv_setnv($arg, (double)$var); T_NV - sv_setnv($arg, (double)$var); + sv_setnv($arg, (NV)$var); T_DOUBLE sv_setnv($arg, (double)$var); T_PV sv_setpv((SV*)$arg, $var); T_PTR - sv_setiv($arg, (IV)$var); + sv_setiv($arg, PTR2IV($var)); T_PTRREF sv_setref_pv($arg, Nullch, (void*)$var); T_REF_IV_REF diff --git a/contrib/perl5/lib/ExtUtils/xsubpp b/contrib/perl5/lib/ExtUtils/xsubpp index 5a71e896362f..bb8f3aab0466 100755 --- a/contrib/perl5/lib/ExtUtils/xsubpp +++ b/contrib/perl5/lib/ExtUtils/xsubpp @@ -109,7 +109,7 @@ sub Q ; # Global Constants -$XSUBPP_version = "1.9507"; +$XSUBPP_version = "1.9508"; my ($Is_VMS, $SymSet); if ($^O eq 'VMS') { @@ -288,7 +288,7 @@ $END = "!End!\n\n"; # "impossible" keyword (multiple newline) # Match an XS keyword $BLOCK_re= '\s*(' . join('|', qw( REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT - CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE + CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL )) . "|$END)\\s*:"; @@ -418,7 +418,7 @@ sub INPUT_handler { $var_init =~ s/"/\\"/g; s/\s+/ /g; - my ($var_type, $var_addr, $var_name) = /^(.*?[^& ]) *(\&?) *\b(\w+)$/s + my ($var_type, $var_addr, $var_name) = /^(.*?[^&\s])\s*(\&?)\s*\b(\w+)$/s or blurt("Error: invalid argument declaration '$line'"), next; # Check for duplicate definitions @@ -444,12 +444,9 @@ sub INPUT_handler { $proto_arg[$var_num] = ProtoString($var_type) if $var_num ; - if ($var_addr) { - $var_addr{$var_name} = 1; - $func_args =~ s/\b($var_name)\b/&$1/; - } + $func_args =~ s/\b($var_name)\b/&$1/ if $var_addr; if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/ - or $in_out{$var_name} and $in_out{$var_name} eq 'OUTLIST' + or $in_out{$var_name} and $in_out{$var_name} =~ /^OUT/ and $var_init !~ /\S/) { if ($name_printed) { print ";\n"; @@ -494,6 +491,8 @@ sub OUTPUT_handler { } else { &generate_output($var_types{$outarg}, $var_num, $outarg, $DoSetMagic); } + delete $in_out{$outarg} # No need to auto-OUTPUT + if exists $in_out{$outarg} and $in_out{$outarg} =~ /OUT$/; } } @@ -573,6 +572,15 @@ sub GetAliases if $line ; } +sub ATTRS_handler () +{ + for (; !/^$BLOCK_re/o; $_ = shift(@line)) { + next unless /\S/; + TrimWhitespace($_) ; + push @Attributes, $_; + } +} + sub ALIAS_handler () { for (; !/^$BLOCK_re/o; $_ = shift(@line)) { @@ -847,7 +855,25 @@ EOM print("#line 1 \"$filename\"\n") if $WantLineNumbers; +firstmodule: while (<$FH>) { + if (/^=/) { + my $podstartline = $.; + do { + if (/^=cut\s*$/) { + print("/* Skipped embedded POD. */\n"); + printf("#line %d \"$filename\"\n", $. + 1) + if $WantLineNumbers; + next firstmodule + } + + } while (<$FH>); + # At this point $. is at end of file so die won't state the start + # of the problem, and as we haven't yet read any lines &death won't + # show the correct line in the message either. + die ("Error: Unterminated pod in $filename, line $podstartline\n") + unless $lastline; + } last if ($Module, $Package, $Prefix) = /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/; @@ -886,6 +912,16 @@ sub fetch_para { } for(;;) { + # Skip embedded PODs + while ($lastline =~ /^=/) { + while ($lastline = <$FH>) { + last if ($lastline =~ /^=cut\s*$/); + } + death ("Error: Unterminated pod") unless $lastline; + $lastline = <$FH>; + chomp $lastline; + $lastline =~ s/^\s+$//; + } if ($lastline !~ /^\s*#/ || # CPP directives: # ANSI: if ifdef ifndef elif else endif define undef @@ -966,7 +1002,6 @@ while (fetch_para()) { # initialize info arrays undef(%args_match); undef(%var_types); - undef(%var_addr); undef(%defaults); undef($class); undef($static); @@ -978,7 +1013,7 @@ while (fetch_para()) { undef(@arg_with_types) ; undef($processing_arg_with_types) ; undef(%arg_types) ; - undef(@in_out) ; + undef(@outlist) ; undef(%in_out) ; undef($proto_in_this_xsub) ; undef($scope_in_this_xsub) ; @@ -1039,12 +1074,12 @@ while (fetch_para()) { last; } $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ; - %XsubAliases = %XsubAliasValues = %Interfaces = (); + %XsubAliases = %XsubAliasValues = %Interfaces = @Attributes = (); $DoSetMagic = 1; $orig_args =~ s/\\\s*/ /g; # process line continuations - my %out_vars; + my %only_outlist; if ($process_argtypes and $orig_args =~ /\S/) { my $args = "$orig_args ,"; if ($args =~ /^( (??{ $C_arg }) , )* $ /x) { @@ -1059,10 +1094,10 @@ while (fetch_para()) { next unless length $pre; my $out_type; my $inout_var; - if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST)\s+//) { + if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//) { my $type = $1; $out_type = $type if $type ne 'IN'; - $arg =~ s/^(IN|IN_OUTLIST|OUTLIST)\s+//; + $arg =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//; } if (/\W/) { # Has a type push @arg_with_types, $arg; @@ -1070,8 +1105,8 @@ while (fetch_para()) { $arg_types{$name} = $arg; $_ = "$name$default"; } - $out_vars{$_} = 1 if $out_type eq 'OUTLIST'; - push @in_out, $name if $out_type; + $only_outlist{$_} = 1 if $out_type eq "OUTLIST"; + push @outlist, $name if $out_type =~ /OUTLIST$/; $in_out{$name} = $out_type if $out_type; } } else { @@ -1081,11 +1116,11 @@ while (fetch_para()) { } else { @args = split(/\s*,\s*/, $orig_args); for (@args) { - if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST)\s+//) { + if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|IN_OUT|OUT)\s+//) { my $out_type = $1; next if $out_type eq 'IN'; - $out_vars{$_} = 1 if $out_type eq 'OUTLIST'; - push @in_out, $name; + $only_outlist{$_} = 1 if $out_type eq "OUTLIST"; + push @outlist, $name if $out_type =~ /OUTLIST$/; $in_out{$_} = $out_type; } } @@ -1109,7 +1144,7 @@ while (fetch_para()) { last; } } - if ($out_vars{$args[$i]}) { + if ($only_outlist{$args[$i]}) { push @args_num, undef; } else { push @args_num, ++$num_args; @@ -1210,7 +1245,7 @@ EOF $gotRETVAL = 0; INPUT_handler() ; - process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|PROTOTYPE|SCOPE") ; + process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|ATTRS|PROTOTYPE|SCOPE") ; print Q<<"EOF" if $ScopeThisXSUB; # ENTER; @@ -1252,7 +1287,7 @@ EOF } print $deferred; - process_keyword("INIT|ALIAS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ; + process_keyword("INIT|ALIAS|ATTRS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ; if (check_keyword("PPCODE")) { print_section(); @@ -1296,7 +1331,10 @@ EOF # $wantRETVAL set if 'RETVAL =' autogenerated ($wantRETVAL, $ret_type) = (0, 'void') if $RETVAL_no_return; undef %outargs ; - process_keyword("POSTCALL|OUTPUT|ALIAS|PROTOTYPE"); + process_keyword("POSTCALL|OUTPUT|ALIAS|ATTRS|PROTOTYPE"); + + &generate_output($var_types{$_}, $args_match{$_}, $_, $DoSetMagic) + for grep $in_out{$_} =~ /OUT$/, keys %in_out; # all OUTPUT done, so now push the return value on the stack if ($gotRETVAL && $RETVAL_code) { @@ -1334,14 +1372,14 @@ EOF $xsreturn = 1 if $ret_type ne "void"; my $num = $xsreturn; - my $c = @in_out; + my $c = @outlist; print "\tXSprePUSH;" if $c and not $prepush_done; print "\tEXTEND(SP,$c);\n" if $c; $xsreturn += $c; - generate_output($var_types{$_}, $num++, $_, 0, 1) for @in_out; + generate_output($var_types{$_}, $num++, $_, 0, 1) for @outlist; # do cleanup - process_keyword("CLEANUP|ALIAS|PROTOTYPE") ; + process_keyword("CLEANUP|ALIAS|ATTRS|PROTOTYPE") ; print Q<<"EOF" if $ScopeThisXSUB; # ]] @@ -1431,6 +1469,12 @@ EOF EOF } } + elsif (@Attributes) { + push(@InitFileCode, Q<<"EOF"); +# cv = newXS(\"$pname\", XS_$Full_func_name, file); +# apply_attrs_string("$Package", cv, "@Attributes", 0); +EOF + } elsif ($interface) { while ( ($name, $value) = each %Interfaces) { $name = "$Package\::$name" unless $name =~ /::/; diff --git a/contrib/perl5/lib/File/Basename.pm b/contrib/perl5/lib/File/Basename.pm index 4581e7e93c26..94aac2dd44e2 100644 --- a/contrib/perl5/lib/File/Basename.pm +++ b/contrib/perl5/lib/File/Basename.pm @@ -176,7 +176,7 @@ sub fileparse { $dirpath ||= ''; # should always be defined } } - if ($fstype =~ /^MS(DOS|Win32)/i) { + if ($fstype =~ /^MS(DOS|Win32)|epoc/i) { ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/s); $dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/; } @@ -189,9 +189,13 @@ sub fileparse { } elsif ($fstype !~ /^VMS/i) { # default to Unix ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#s); - if ($^O eq 'VMS' and $fullname =~ m:/[^/]+/000000/?:) { + if ($^O eq 'VMS' and $fullname =~ m:^(/[^/]+/000000(/|$))(.*):) { # dev:[000000] is top of VMS tree, similar to Unix '/' - ($basename,$dirpath) = ('',$fullname); + # so strip it off and treat the rest as "normal" + my $devspec = $1; + my $remainder = $3; + ($dirpath,$basename) = ($remainder =~ m#^(.*/)?(.*)#s); + $dirpath = $devspec.$dirpath; } $dirpath = './' unless $dirpath; } @@ -236,7 +240,13 @@ sub dirname { if ($_[0] =~ m#/#) { $fstype = '' } else { return $dirname || $ENV{DEFAULT} } } - if ($fstype =~ /MacOS/i) { return $dirname } + if ($fstype =~ /MacOS/i) { + if( !length($basename) && $dirname !~ /^[^:]+:\z/) { + $dirname =~ s/([^:]):\z/$1/s; + ($basename,$dirname) = fileparse $dirname; + } + $dirname .= ":" unless $dirname =~ /:\z/; + } elsif ($fstype =~ /MSDOS/i) { $dirname =~ s/([^:])[\\\/]*\z/$1/; unless( length($basename) ) { @@ -256,7 +266,7 @@ sub dirname { chop $dirname; $dirname =~ s#[^:/]+\z## unless length($basename); } - else { + else { $dirname =~ s:(.)/*\z:$1:s; unless( length($basename) ) { local($File::Basename::Fileparse_fstype) = $fstype; diff --git a/contrib/perl5/lib/File/Copy.pm b/contrib/perl5/lib/File/Copy.pm index e6cf78603423..24d1ffdf630c 100644 --- a/contrib/perl5/lib/File/Copy.pm +++ b/contrib/perl5/lib/File/Copy.pm @@ -37,7 +37,7 @@ sub _catname { # Will be replaced by File::Spec when it arrives import File::Basename 'basename'; } if ($^O eq 'VMS') { $to = VMS::Filespec::vmspath($to) . basename($from); } - elsif ($^O eq 'MacOS') { $to .= ':' . basename($from); } + elsif ($^O eq 'MacOS') { $to =~ s/^([^:]+)$/:$1/; $to .= ':' . basename($from); } elsif ($to =~ m|\\|) { $to .= '\\' . basename($from); } else { $to .= '/' . basename($from); } } @@ -69,6 +69,7 @@ sub copy { && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles && !($from_a_handle && $^O eq 'mpeix') # and neither can MPE/iX. && !($from_a_handle && $^O eq 'MSWin32') + && !($from_a_handle && $^O eq 'MacOS') ) { return syscopy($from, $to); @@ -83,7 +84,7 @@ sub copy { if ($from_a_handle) { *FROM = *$from{FILEHANDLE}; } else { - $from = "./$from" if $from =~ /^\s/s; + $from = _protect($from) if $from =~ /^\s/s; open(FROM, "< $from\0") or goto fail_open1; binmode FROM or die "($!,$^E)"; $closefrom = 1; @@ -92,7 +93,7 @@ sub copy { if ($to_a_handle) { *TO = *$to{FILEHANDLE}; } else { - $to = "./$to" if $to =~ /^\s/s; + $to = _protect($to) if $to =~ /^\s/s; open(TO,"> $to\0") or goto fail_open2; binmode TO or die "($!,$^E)"; $closeto = 1; @@ -180,6 +181,13 @@ sub move { *cp = \© *mv = \&move; + +if ($^O eq 'MacOS') { + *_protect = sub { MacPerl::MakeFSSpec($_[0]) }; +} else { + *_protect = sub { "./$_[0]" }; +} + # &syscopy is an XSUB under OS/2 unless (defined &syscopy) { if ($^O eq 'VMS') { @@ -196,6 +204,23 @@ unless (defined &syscopy) { return 0 unless @_ == 2; return Win32::CopyFile(@_, 1); }; + } elsif ($^O eq 'MacOS') { + require Mac::MoreFiles; + *syscopy = sub { + my($from, $to) = @_; + my($dir, $toname); + + return 0 unless -e $from; + + if ($to =~ /(.*:)([^:]+):?$/) { + ($dir, $toname) = ($1, $2); + } else { + ($dir, $toname) = (":", $to); + } + + unlink($to); + Mac::MoreFiles::FSpFileCopy($from, $dir, $toname, 1); + }; } else { $Syscopy_is_copy = 1; *syscopy = \© @@ -221,7 +246,7 @@ File::Copy - Copy files or filehandles use POSIX; use File::Copy cp; - $n=FileHandle->new("/dev/null","r"); + $n = FileHandle->new("/a/file","r"); cp($n,"x");' =head1 DESCRIPTION diff --git a/contrib/perl5/lib/File/Find.pm b/contrib/perl5/lib/File/Find.pm index ac73f1b5eb24..3a621c0269db 100644 --- a/contrib/perl5/lib/File/Find.pm +++ b/contrib/perl5/lib/File/Find.pm @@ -42,6 +42,22 @@ Reports the name of a directory only AFTER all its entries have been reported. Entry point finddepth() is a shortcut for specifying C<{ bydepth => 1 }> in the first argument of find(). +=item C + +The value should be a code reference. This code reference is used to +preprocess a directory; it is called after readdir() but before the loop that +calls the wanted() function. It is called with a list of strings and is +expected to return a list of strings. The code can be used to sort the +strings alphabetically, numerically, or to filter out directory entries based +on their name alone. + +=item C + +The value should be a code reference. It is invoked just before leaving the +current directory. It is called in void context with no arguments. The name +of the current directory is in $File::Find::dir. This hook is handy for +summarizing a directory, such as calculating its disk usage. + =item C Causes symbolic links to be followed. Since directory trees with symbolic @@ -55,7 +71,7 @@ If either I or I is in effect: =item * -It is guarantueed that an I has been called before the user's +It is guaranteed that an I has been called before the user's I function is called. This enables fast file checks involving S< _>. =item * @@ -67,11 +83,10 @@ pathname of the file with all symbolic links resolved =item C -This is similar to I except that it may report some files -more than once. It does detect cycles however. -Since only symbolic links have to be hashed, this is -much cheaper both in space and time. -If processing a file more than once (by the user's I function) +This is similar to I except that it may report some files more +than once. It does detect cycles, however. Since only symbolic links +have to be hashed, this is much cheaper both in space and time. If +processing a file more than once (by the user's I function) is worse than just taking time, the option I should be used. =item C @@ -97,14 +112,14 @@ C<$_> will be the same as C<$File::Find::name>. If find is used in taint-mode (-T command line switch or if EUID != UID or if EGID != GID) then internally directory names have to be untainted before they can be cd'ed to. Therefore they are checked against a regular -expression I. Note, that all names passed to the +expression I. Note that all names passed to the user's I function are still tainted. =item C See above. This should be set using the C quoting operator. The default is set to C. -Note that the paranthesis which are vital. +Note that the parantheses are vital. =item C @@ -116,15 +131,15 @@ are skipped. The default is to 'die' in such a case. The wanted() function does whatever verifications you want. C<$File::Find::dir> contains the current directory name, and C<$_> the current filename within that directory. C<$File::Find::name> contains -the complete pathname to the file. You are chdir()'d to C<$File::Find::dir> when -the function is called, unless C was specified. -When or are in effect there is also a -C<$File::Find::fullname>. -The function may set C<$File::Find::prune> to prune the tree -unless C was specified. -Unless C or C is specified, for compatibility -reasons (find.pl, find2perl) there are in addition the following globals -available: C<$File::Find::topdir>, C<$File::Find::topdev>, C<$File::Find::topino>, +the complete pathname to the file. You are chdir()'d to +C<$File::Find::dir> when the function is called, unless C +was specified. When or are in effect, there is +also a C<$File::Find::fullname>. The function may set +C<$File::Find::prune> to prune the tree unless C was +specified. Unless C or C is specified, for +compatibility reasons (find.pl, find2perl) there are in addition the +following globals available: C<$File::Find::topdir>, +C<$File::Find::topdev>, C<$File::Find::topino>, C<$File::Find::topmode> and C<$File::Find::topnlink>. This library is useful for the C tool, which when fed, @@ -161,7 +176,7 @@ module. =head1 CAVEAT -Be aware that the option to follow symblic links can be dangerous. +Be aware that the option to follow symbolic links can be dangerous. Depending on the structure of the directory tree (including symbolic links to directories) you might traverse a given (physical) directory more than once (only if C is in effect). @@ -183,7 +198,8 @@ require File::Basename; my %SLnkSeen; my ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow, - $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat); + $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat, + $pre_process, $post_process); sub contract_name { my ($cdir,$fn) = @_; @@ -282,6 +298,8 @@ sub _find_opt { my $cwd_untainted = $cwd; $wanted_callback = $wanted->{wanted}; $bydepth = $wanted->{bydepth}; + $pre_process = $wanted->{preprocess}; + $post_process = $wanted->{postprocess}; $no_chdir = $wanted->{no_chdir}; $full_check = $wanted->{follow}; $follow = $full_check || $wanted->{follow_fast}; @@ -373,7 +391,7 @@ sub _find_opt { $name = $abs_dir . $_; - &$wanted_callback; + { &$wanted_callback }; # protect against wild "next" } @@ -429,7 +447,7 @@ sub _find_dir($$$) { $_= ($no_chdir ? $dir_name : $dir_rel ); # prune may happen here $prune= 0; - &$wanted_callback; + { &$wanted_callback }; # protect against wild "next" next if $prune; } @@ -464,6 +482,8 @@ sub _find_dir($$$) { } @filenames = readdir DIR; closedir(DIR); + @filenames = &$pre_process(@filenames) if $pre_process; + push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process; if ($nlink == 2 && !$avoid_nlink) { # This dir has no subdirectories. @@ -472,7 +492,7 @@ sub _find_dir($$$) { $name = $dir_pref . $FN; $_ = ($no_chdir ? $name : $FN); - &$wanted_callback; + { &$wanted_callback }; # protect against wild "next" } } @@ -496,13 +516,13 @@ sub _find_dir($$$) { else { $name = $dir_pref . $FN; $_= ($no_chdir ? $name : $FN); - &$wanted_callback; + { &$wanted_callback }; # protect against wild "next" } } else { $name = $dir_pref . $FN; $_= ($no_chdir ? $name : $FN); - &$wanted_callback; + { &$wanted_callback }; # protect against wild "next" } } } @@ -518,7 +538,11 @@ sub _find_dir($$$) { } $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel"); $dir_pref = "$dir_name/"; - if ( $nlink < 0 ) { # must be finddepth, report dirname now + if ( $nlink == -2 ) { + $name = $dir = $p_dir; + $_ = "."; + &$post_process; # End-of-directory processing + } elsif ( $nlink < 0 ) { # must be finddepth, report dirname now $name = $dir_name; if ( substr($name,-2) eq '/.' ) { $name =~ s|/\.$||; @@ -528,7 +552,7 @@ sub _find_dir($$$) { if ( substr($_,-2) eq '/.' ) { s|/\.$||; } - &$wanted_callback; + { &$wanted_callback }; # protect against wild "next" } else { push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth; last; @@ -584,13 +608,25 @@ sub _find_dir_symlnk($$$) { while (defined $SE) { unless ($bydepth) { + # change to parent directory + unless ($no_chdir) { + my $udir = $pdir_loc; + if ($untaint) { + $udir = $1 if $pdir_loc =~ m|$untaint_pat|; + } + unless (chdir $udir) { + warn "Can't cd to $udir: $!\n"; + next; + } + } $dir= $p_dir; $name= $dir_name; $_= ($no_chdir ? $dir_name : $dir_rel ); $fullname= $dir_loc; # prune may happen here $prune= 0; - &$wanted_callback; + lstat($_); # make sure file tests with '_' work + { &$wanted_callback }; # protect against wild "next" next if $prune; } @@ -640,7 +676,7 @@ sub _find_dir_symlnk($$$) { $fullname = $new_loc; $name = $dir_pref . $FN; $_ = ($no_chdir ? $name : $FN); - &$wanted_callback; + { &$wanted_callback }; # protect against wild "next" } } @@ -673,7 +709,8 @@ sub _find_dir_symlnk($$$) { s|/\.$||; } - &$wanted_callback; + lstat($_); # make sure file tests with '_' work + { &$wanted_callback }; # protect against wild "next" } else { push @Stack,[$dir_loc, $pdir_loc, $p_dir, $dir_rel,-1] if $bydepth; last; @@ -721,7 +758,8 @@ if ($^O eq 'VMS') { } $File::Find::dont_use_nlink = 1 - if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32'; + if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' || + $^O eq 'cygwin' || $^O eq 'epoc'; # Set dont_use_nlink in your hint file if your system's stat doesn't # report the number of links in a directory as an indication diff --git a/contrib/perl5/lib/File/Path.pm b/contrib/perl5/lib/File/Path.pm index 46f360a46159..0eb6128afe6a 100644 --- a/contrib/perl5/lib/File/Path.pm +++ b/contrib/perl5/lib/File/Path.pm @@ -97,38 +97,42 @@ use File::Basename (); use Exporter (); use strict; -our $VERSION = "1.0403"; +our $VERSION = "1.0404"; our @ISA = qw( Exporter ); our @EXPORT = qw( mkpath rmtree ); my $Is_VMS = $^O eq 'VMS'; +my $Is_MacOS = $^O eq 'MacOS'; # These OSes complain if you want to remove a file that you have no # write permission to: -my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' - || $^O eq 'amigaos'); +my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' || + $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc'); sub mkpath { my($paths, $verbose, $mode) = @_; # $paths -- either a path string or ref to list of paths # $verbose -- optional print "mkdir $path" for each directory created # $mode -- optional permissions, defaults to 0777 - local($")="/"; + local($")=$Is_MacOS ? ":" : "/"; $mode = 0777 unless defined($mode); $paths = [$paths] unless ref $paths; my(@created,$path); foreach $path (@$paths) { $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT - next if -d $path; # Logic wants Unix paths, so go with the flow. - $path = VMS::Filespec::unixify($path) if $Is_VMS; - my $parent = File::Basename::dirname($path); - # Allow for creation of new logical filesystems under VMS - if (not $Is_VMS or $parent !~ m:/[^/]+/000000/?:) { - unless (-d $parent or $path eq $parent) { - push(@created,mkpath($parent, $verbose, $mode)); + if ($Is_VMS) { + next if $path eq '/'; + $path = VMS::Filespec::unixify($path); + if ($path =~ m:^(/[^/]+)/?\z:) { + $path = $1.'/000000'; } } + next if -d $path; + my $parent = File::Basename::dirname($path); + unless (-d $parent or $path eq $parent) { + push(@created,mkpath($parent, $verbose, $mode)); + } print "mkdir $path\n" if $verbose; unless (mkdir($path,$mode)) { my $e = $!; @@ -157,7 +161,12 @@ sub rmtree { my($root); foreach $root (@{$roots}) { - $root =~ s#/\z##; + if ($Is_MacOS) { + $root = ":$root" if $root !~ /:/; + $root =~ s#([^:])\z#$1:#; + } else { + $root =~ s#/\z##; + } (undef, undef, my $rp) = lstat $root or next; $rp &= 07777; # don't forget setuid, setgid, sticky bits if ( -d _ ) { @@ -182,7 +191,11 @@ sub rmtree { # is faster if done in reverse ASCIIbetical order @files = reverse @files if $Is_VMS; ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS; - @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files); + if ($Is_MacOS) { + @files = map("$root$_", @files); + } else { + @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files); + } $count += rmtree(\@files,$verbose,$safe); if ($safe && ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) { diff --git a/contrib/perl5/lib/File/Spec.pm b/contrib/perl5/lib/File/Spec.pm index 40f5345140c7..3f79d74b66ac 100644 --- a/contrib/perl5/lib/File/Spec.pm +++ b/contrib/perl5/lib/File/Spec.pm @@ -3,12 +3,13 @@ package File::Spec; use strict; use vars qw(@ISA $VERSION); -$VERSION = '0.8'; +$VERSION = 0.82 ; my %module = (MacOS => 'Mac', MSWin32 => 'Win32', os2 => 'OS2', - VMS => 'VMS'); + VMS => 'VMS', + epoc => 'Epoc'); my $module = $module{$^O} || 'Unix'; require "File/Spec/$module.pm"; diff --git a/contrib/perl5/lib/File/Spec/Functions.pm b/contrib/perl5/lib/File/Spec/Functions.pm index 140738f44398..0036ac1ded00 100644 --- a/contrib/perl5/lib/File/Spec/Functions.pm +++ b/contrib/perl5/lib/File/Spec/Functions.pm @@ -3,7 +3,9 @@ package File::Spec::Functions; use File::Spec; use strict; -use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); +use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); + +$VERSION = '1.1'; require Exporter; diff --git a/contrib/perl5/lib/File/Spec/Mac.pm b/contrib/perl5/lib/File/Spec/Mac.pm index 959e33d0cf3b..9ef55ec84ad8 100644 --- a/contrib/perl5/lib/File/Spec/Mac.pm +++ b/contrib/perl5/lib/File/Spec/Mac.pm @@ -1,8 +1,11 @@ package File::Spec::Mac; use strict; -use vars qw(@ISA); +use vars qw(@ISA $VERSION); require File::Spec::Unix; + +$VERSION = '1.2'; + @ISA = qw(File::Spec::Unix); =head1 NAME @@ -79,9 +82,9 @@ sub catdir { shift; my @args = @_; my $result = shift @args; - $result =~ s/:\z//; + $result =~ s/:\Z(?!\n)//; foreach (@args) { - s/:\z//; + s/:\Z(?!\n)//; s/^://s; $result .= ":$_"; } @@ -150,7 +153,7 @@ sub rootdir { require Mac::Files; my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk, &Mac::Files::kSystemFolderType); - $system =~ s/:.*\z/:/s; + $system =~ s/:.*\Z(?!\n)/:/s; return $system; } @@ -189,12 +192,16 @@ folder named "HD" in the current working directory on a drive named "HD"), relative wins. Use ":" in the appropriate place in the path if you want to distinguish unambiguously. +As a special case, the file name '' is always considered to be absolute. + =cut sub file_name_is_absolute { my ($self,$file) = @_; if ($file =~ /:/) { return ($file !~ m/^:/s); + } elsif ( $file eq '' ) { + return 1 ; } else { return (! -e ":$file"); } @@ -228,7 +235,7 @@ sub splitpath { my ($volume,$directory,$file) = ('','',''); if ( $nofile ) { - ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|\z))?)(.*)@s; + ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|\Z(?!\n)))?)(.*)@s; } else { $path =~ @@ -242,8 +249,8 @@ sub splitpath { } # Make sure non-empty volumes and directories end in ':' - $volume .= ':' if $volume =~ m@[^:]\z@ ; - $directory .= ':' if $directory =~ m@[^:]\z@ ; + $volume .= ':' if $volume =~ m@[^:]\Z(?!\n)@ ; + $directory .= ':' if $directory =~ m@[^:]\Z(?!\n)@ ; return ($volume,$directory,$file); } @@ -259,7 +266,7 @@ sub splitdir { # check to be sure that there will not be any before handling the # simple case. # - if ( $directories !~ m@:\z@ ) { + if ( $directories !~ m@:\Z(?!\n)@ ) { return split( m@:@, $directories ); } else { @@ -286,11 +293,11 @@ sub catpath { my $segment ; for $segment ( @_ ) { - if ( $result =~ m@[^/]\z@ && $segment =~ m@^[^/]@s ) { + if ( $result =~ m@[^/]\Z(?!\n)@ && $segment =~ m@^[^/]@s ) { $result .= "/$segment" ; } - elsif ( $result =~ m@/\z@ && $segment =~ m@^/@s ) { - $result =~ s@/+\z@/@; + elsif ( $result =~ m@/\Z(?!\n)@ && $segment =~ m@^/@s ) { + $result =~ s@/+\Z(?!\n)@/@; $segment =~ s@^/+@@s; $result .= "$segment" ; } @@ -304,6 +311,12 @@ sub catpath { =item abs2rel +See L for general documentation. + +Unlike Cabs2rel()>, this function will make +checks against the local filesystem if necessary. See +L for details. + =cut sub abs2rel { @@ -341,31 +354,15 @@ sub abs2rel { =item rel2abs -Converts a relative path to an absolute path. +See L for general documentation. - $abs_path = File::Spec->rel2abs( $destination ) ; - $abs_path = File::Spec->rel2abs( $destination, $base ) ; - -If $base is not present or '', then L is used. If $base is relative, -then it is converted to absolute form using L. This means that it -is taken to be relative to L. - -On systems with the concept of a volume, this assumes that both paths -are on the $base volume, and ignores the $destination volume. - -On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be -directories. - -If $path is absolute, it is cleaned up and returned using L. - -Based on code written by Shigio Yamaguchi. - -No checks against the filesystem are made. +Unlike Crel2abs()>, this function will make +checks against the local filesystem if necessary. See +L for details. =cut -sub rel2abs($;$;) { +sub rel2abs { my ($self,$path,$base ) = @_; if ( ! $self->file_name_is_absolute( $path ) ) { diff --git a/contrib/perl5/lib/File/Spec/OS2.pm b/contrib/perl5/lib/File/Spec/OS2.pm index 33370f06c195..20bf8c9dcefb 100644 --- a/contrib/perl5/lib/File/Spec/OS2.pm +++ b/contrib/perl5/lib/File/Spec/OS2.pm @@ -1,8 +1,11 @@ package File::Spec::OS2; use strict; -use vars qw(@ISA); +use vars qw(@ISA $VERSION); require File::Spec::Unix; + +$VERSION = '1.1'; + @ISA = qw(File::Spec::Unix); sub devnull { diff --git a/contrib/perl5/lib/File/Spec/Unix.pm b/contrib/perl5/lib/File/Spec/Unix.pm index 2305b75b761f..a81c533235f2 100644 --- a/contrib/perl5/lib/File/Spec/Unix.pm +++ b/contrib/perl5/lib/File/Spec/Unix.pm @@ -1,6 +1,9 @@ package File::Spec::Unix; use strict; +use vars qw($VERSION); + +$VERSION = '1.2'; use Cwd; @@ -35,7 +38,7 @@ sub canonpath { $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx $path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx $path =~ s|^/(\.\./)+|/|s; # /../../xx -> xx - $path =~ s|/\z|| unless $path eq "/"; # xx/ -> xx + $path =~ s|/\Z(?!\n)|| unless $path eq "/"; # xx/ -> xx return $path; } @@ -146,7 +149,7 @@ directory. (Does not strip symlinks, only '.', '..', and equivalents.) sub no_upwards { my $self = shift; - return grep(!/^\.{1,2}\z/s, @_); + return grep(!/^\.{1,2}\Z(?!\n)/s, @_); } =item case_tolerant @@ -162,7 +165,12 @@ sub case_tolerant { =item file_name_is_absolute -Takes as argument a path and returns true, if it is an absolute path. +Takes as argument a path and returns true if it is an absolute path. + +This does not consult the local filesystem on Unix, Win32, or OS/2. It +does sometimes on MacOS (see L). +It does consult the working environment for VMS (see +L). =cut @@ -223,7 +231,7 @@ sub splitpath { $directory = $path; } else { - $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs; + $path =~ m|^ ( (?: .* / (?: \.\.?\Z(?!\n) )? )? ) ([^/]*) |xs; $directory = $1; $file = $2; } @@ -263,7 +271,7 @@ sub splitdir { # check to be sure that there will not be any before handling the # simple case. # - if ( $directories !~ m|/\z| ) { + if ( $directories !~ m|/\Z(?!\n)| ) { return split( m|/|, $directories ); } else { @@ -308,8 +316,8 @@ sub catpath { Takes a destination path and an optional base path returns a relative path from the base path to the destination path: - $rel_path = File::Spec->abs2rel( $destination ) ; - $rel_path = File::Spec->abs2rel( $destination, $base ) ; + $rel_path = File::Spec->abs2rel( $path ) ; + $rel_path = File::Spec->abs2rel( $path, $base ) ; If $base is not present or '', then L is used. If $base is relative, then it is converted to absolute form using L. This means that it @@ -325,9 +333,13 @@ directories. If $path is relative, it is converted to absolute form using L. This means that it is taken to be relative to L. -Based on code written by Shigio Yamaguchi. +No checks against the filesystem are made on most systems. On MacOS, +the filesystem may be consulted (see +L). On VMS, there is +interaction with the working environment, as logicals and +macros are expanded. -No checks against the filesystem are made. +Based on code written by Shigio Yamaguchi. =cut @@ -385,15 +397,15 @@ sub abs2rel { Converts a relative path to an absolute path. - $abs_path = File::Spec->rel2abs( $destination ) ; - $abs_path = File::Spec->rel2abs( $destination, $base ) ; + $abs_path = File::Spec->rel2abs( $path ) ; + $abs_path = File::Spec->rel2abs( $path, $base ) ; If $base is not present or '', then L is used. If $base is relative, then it is converted to absolute form using L. This means that it is taken to be relative to L. On systems with the concept of a volume, this assumes that both paths -are on the $base volume, and ignores the $destination volume. +are on the $base volume, and ignores the $path volume. On systems that have a grammar that indicates filenames, this ignores the $base filename as well. Otherwise all path components are assumed to be @@ -401,13 +413,17 @@ directories. If $path is absolute, it is cleaned up and returned using L. -Based on code written by Shigio Yamaguchi. +No checks against the filesystem are made on most systems. On MacOS, +the filesystem may be consulted (see +L). On VMS, there is +interaction with the working environment, as logicals and +macros are expanded. -No checks against the filesystem are made. +Based on code written by Shigio Yamaguchi. =cut -sub rel2abs($;$;) { +sub rel2abs { my ($self,$path,$base ) = @_; # Clean up $path diff --git a/contrib/perl5/lib/File/Spec/VMS.pm b/contrib/perl5/lib/File/Spec/VMS.pm index a2ac8cac0bb5..60b0ec8e50dc 100644 --- a/contrib/perl5/lib/File/Spec/VMS.pm +++ b/contrib/perl5/lib/File/Spec/VMS.pm @@ -1,8 +1,11 @@ package File::Spec::VMS; use strict; -use vars qw(@ISA); +use vars qw(@ISA $VERSION); require File::Spec::Unix; + +$VERSION = '1.1'; + @ISA = qw(File::Spec::Unix); use Cwd; @@ -37,6 +40,11 @@ sub eliminate_macros { my($self,$path) = @_; return '' unless $path; $self = {} unless ref $self; + + if ($path =~ /\s/) { + return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path; + } + my($npath) = unixify($path); my($complex) = 0; my($head,$macro,$tail); @@ -56,7 +64,7 @@ sub eliminate_macros { $complex = 1; } } - else { ($macro = unixify($self->{$macro})) =~ s#/\z##; } + else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; } $npath = "$head$macro$tail"; } } @@ -86,8 +94,14 @@ sub fixpath { $self = bless {} unless ref $self; my($fixedpath,$prefix,$name); - if ($path =~ m#^\$\([^\)]+\)\z#s || $path =~ m#[/:>\]]#) { - if ($force_path or $path =~ /(?:DIR\)|\])\z/) { + if ($path =~ /\s/) { + return join ' ', + map { $self->fixpath($_,$force_path) } + split /\s+/, $path; + } + + if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { + if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) { $fixedpath = vmspath($self->eliminate_macros($path)); } else { @@ -97,7 +111,7 @@ sub fixpath { elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) { my($vmspre) = $self->eliminate_macros("\$($prefix)"); # is it a dir or just a name? - $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\z/) ? vmspath($vmspre) : ''; + $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : ''; $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name; $fixedpath = vmspath($fixedpath) if $force_path; } @@ -136,7 +150,7 @@ sub canonpath { my($self,$path) = @_; if ($path =~ m|/|) { # Fake Unix - my $pathify = $path =~ m|/\z|; + my $pathify = $path =~ m|/\Z(?!\n)|; $path = $self->SUPER::canonpath($path); if ($pathify) { return vmspath($path); } else { return vmsify($path); } @@ -169,8 +183,8 @@ sub catdir { if (@dirs) { my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs)); my ($spath,$sdir) = ($path,$dir); - $spath =~ s/\.dir\z//; $sdir =~ s/\.dir\z//; - $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\z/s; + $spath =~ s/\.dir\Z(?!\n)//; $sdir =~ s/\.dir\Z(?!\n)//; + $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\Z(?!\n)/s; $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1); # Special case for VMS absolute directory specs: these will have had device @@ -181,7 +195,7 @@ sub catdir { } else { if (not defined $dir or not length $dir) { $rslt = ''; } - elsif ($dir =~ /^\$\([^\)]+\)\z/s) { $rslt = $dir; } + elsif ($dir =~ /^\$\([^\)]+\)\Z(?!\n)/s) { $rslt = $dir; } else { $rslt = vmspath($dir); } } return $self->canonpath($rslt); @@ -202,8 +216,8 @@ sub catfile { if (@files) { my $path = (@files == 1 ? $files[0] : $self->catdir(@files)); my $spath = $path; - $spath =~ s/\.dir\z//; - if ($spath =~ /^[^\)\]\/:>]+\)\z/s && basename($file) eq $file) { + $spath =~ s/\.dir\Z(?!\n)//; + if ($spath =~ /^[^\)\]\/:>]+\)\Z(?!\n)/s && basename($file) eq $file) { $rslt = "$spath$file"; } else { @@ -251,7 +265,7 @@ sub rootdir { Returns a string representation of the first writable directory from the following list or '' if none are writable: - sys$scratch + sys$scratch: $ENV{TMPDIR} =cut @@ -259,7 +273,7 @@ from the following list or '' if none are writable: my $tmpdir; sub tmpdir { return $tmpdir if defined $tmpdir; - foreach ('sys$scratch', $ENV{TMPDIR}) { + foreach ('sys$scratch:', $ENV{TMPDIR}) { next unless defined && -d && -w _; $tmpdir = $_; last; @@ -310,7 +324,7 @@ Checks for VMS directory spec as well as Unix separators. sub file_name_is_absolute { my ($self,$file) = @_; # If it's a logical name, expand it. - $file = $ENV{$file} while $file =~ /^[\w\$\-]+\z/s && $ENV{$file}; + $file = $ENV{$file} while $file =~ /^[\w\$\-]+\Z(?!\n)/s && $ENV{$file}; return scalar($file =~ m!^/!s || $file =~ m![<\[][^.\-\]>]! || $file =~ /:[^<\[]/); @@ -341,7 +355,7 @@ sub splitdir { $dirspec =~ s/\]\[//g; $dirspec =~ s/\-\-/-.-/g; $dirspec = "[$dirspec]" unless $dirspec =~ /[\[<]/; # make legal my(@dirs) = split('\.', vmspath($dirspec)); - $dirs[0] =~ s/^[\[<]//s; $dirs[-1] =~ s/[\]>]\z//s; + $dirs[0] =~ s/^[\[<]//s; $dirs[-1] =~ s/[\]>]\Z(?!\n)//s; @dirs; } @@ -355,7 +369,7 @@ Construct a complete filespec using VMS syntax sub catpath { my($self,$dev,$dir,$file) = @_; if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; } - else { $dev .= ':' unless $dev eq '' or $dev =~ /:\z/; } + else { $dev .= ':' unless $dev eq '' or $dev =~ /:\Z(?!\n)/; } if (length($dev) or length($dir)) { $dir = "[$dir]" unless $dir =~ /[\[<\/]/; $dir = vmspath($dir); @@ -400,17 +414,16 @@ sub abs2rel { } # Split up paths - my ( undef, $path_directories, $path_file ) = - $self->splitpath( $path, 1 ) ; + my ( $path_directories, $path_file ) = + ($self->splitpath( $path, 1 ))[1,2] ; $path_directories = $1 - if $path_directories =~ /^\[(.*)\]\z/s ; + if $path_directories =~ /^\[(.*)\]\Z(?!\n)/s ; - my ( undef, $base_directories, undef ) = - $self->splitpath( $base, 1 ) ; + my $base_directories = ($self->splitpath( $base, 1 ))[1] ; $base_directories = $1 - if $base_directories =~ /^\[(.*)\]\z/s ; + if $base_directories =~ /^\[(.*)\]\Z(?!\n)/s ; # Now, remove all leading components that are the same my @pathchunks = $self->splitdir( $path_directories ); @@ -427,7 +440,7 @@ sub abs2rel { # @basechunks now contains the directories to climb out of, # @pathchunks now has the directories to descend in to. $path_directories = '-.' x @basechunks . join( '.', @pathchunks ) ; - $path_directories =~ s{\.\z}{} ; + $path_directories =~ s{\.\Z(?!\n)}{} ; return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ; } @@ -438,7 +451,7 @@ Use VMS syntax when converting filespecs. =cut -sub rel2abs($;$;) { +sub rel2abs { my $self = shift ; return vmspath(File::Spec::Unix::rel2abs( $self, @_ )) if ( join( '', @_ ) =~ m{/} ) ; @@ -458,17 +471,17 @@ sub rel2abs($;$;) { } # Split up paths - my ( undef, $path_directories, $path_file ) = - $self->splitpath( $path ) ; + my ( $path_directories, $path_file ) = + ($self->splitpath( $path ))[1,2] ; - my ( $base_volume, $base_directories, undef ) = + my ( $base_volume, $base_directories ) = $self->splitpath( $base ) ; $path_directories = '' if $path_directories eq '[]' || $path_directories eq '<>'; my $sep = '' ; $sep = '.' - if ( $base_directories =~ m{[^.\]>]\z} && + if ( $base_directories =~ m{[^.\]>]\Z(?!\n)} && $path_directories =~ m{^[^.\[<]}s ) ; $base_directories = "$base_directories$sep$path_directories"; diff --git a/contrib/perl5/lib/File/Spec/Win32.pm b/contrib/perl5/lib/File/Spec/Win32.pm index aa95fbde363e..3c019853f112 100644 --- a/contrib/perl5/lib/File/Spec/Win32.pm +++ b/contrib/perl5/lib/File/Spec/Win32.pm @@ -2,8 +2,11 @@ package File::Spec::Win32; use strict; use Cwd; -use vars qw(@ISA); +use vars qw(@ISA $VERSION); require File::Spec::Unix; + +$VERSION = '1.2'; + @ISA = qw(File::Spec::Unix); =head1 NAME @@ -40,6 +43,7 @@ from the following list: $ENV{TMPDIR} $ENV{TEMP} $ENV{TMP} + C:/temp /tmp / @@ -49,7 +53,7 @@ my $tmpdir; sub tmpdir { return $tmpdir if defined $tmpdir; my $self = shift; - foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)) { + foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(C:/temp /tmp /)) { next unless defined && -d; $tmpdir = $_; last; @@ -105,8 +109,8 @@ sub canonpath { $path =~ s|([^\\])\\+|$1\\|g; # xx////xx -> xx/xx $path =~ s|(\\\.)+\\|\\|g; # xx/././xx -> xx/xx $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # ./xx -> xx - $path =~ s|\\\z|| - unless $path =~ m#^([A-Z]:)?\\\z#s; # xx/ -> xx + $path =~ s|\\\Z(?!\n)|| + unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s; # xx/ -> xx return $path; } @@ -146,7 +150,7 @@ sub splitpath { (?:\\\\|//)[^\\/]+[\\/][^\\/]+ )? ) - ( (?:.*[\\\\/](?:\.\.?\z)?)? ) + ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? ) (.*) }xs; $volume = $1; @@ -187,7 +191,7 @@ sub splitdir { # check to be sure that there will not be any before handling the # simple case. # - if ( $directories !~ m|[\\/]\z| ) { + if ( $directories !~ m|[\\/]\Z(?!\n)| ) { return split( m|[\\/]|, $directories ); } else { @@ -216,7 +220,7 @@ sub catpath { # If it's UNC, make sure the glue separator is there, reusing # whatever separator is first in the $volume $volume .= $1 - if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\z@s && + if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s && $directory =~ m@^[^\\/]@s ) ; @@ -224,8 +228,8 @@ sub catpath { # If the volume is not just A:, make sure the glue separator is # there, reusing whatever separator is first in the $volume if possible. - if ( $volume !~ m@^[a-zA-Z]:\z@s && - $volume =~ m@[^\\/]\z@ && + if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s && + $volume =~ m@[^\\/]\Z(?!\n)@ && $file =~ m@[^\\/]@ ) { $volume =~ m@([\\/])@ ; @@ -239,34 +243,6 @@ sub catpath { } -=item abs2rel - -Takes a destination path and an optional base path returns a relative path -from the base path to the destination path: - - $rel_path = File::Spec->abs2rel( $destination ) ; - $rel_path = File::Spec->abs2rel( $destination, $base ) ; - -If $base is not present or '', then L is used. If $base is relative, -then it is converted to absolute form using L. This means that it -is taken to be relative to L. - -On systems with the concept of a volume, this assumes that both paths -are on the $destination volume, and ignores the $base volume. - -On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be -directories. - -If $path is relative, it is converted to absolute form using L. -This means that it is taken to be relative to L. - -Based on code written by Shigio Yamaguchi. - -No checks against the filesystem are made. - -=cut - sub abs2rel { my($self,$path,$base) = @_; @@ -293,8 +269,7 @@ sub abs2rel { my ( $path_volume, $path_directories, $path_file ) = $self->splitpath( $path, 1 ) ; - my ( undef, $base_directories, undef ) = - $self->splitpath( $base, 1 ) ; + my $base_directories = ($self->splitpath( $base, 1 ))[1] ; # Now, remove all leading components that are the same my @pathchunks = $self->splitdir( $path_directories ); @@ -337,33 +312,8 @@ sub abs2rel { ) ; } -=item rel2abs -Converts a relative path to an absolute path. - - $abs_path = File::Spec->rel2abs( $destination ) ; - $abs_path = File::Spec->rel2abs( $destination, $base ) ; - -If $base is not present or '', then L is used. If $base is relative, -then it is converted to absolute form using L. This means that it -is taken to be relative to L. - -Assumes that both paths are on the $base volume, and ignores the -$destination volume. - -On systems that have a grammar that indicates filenames, this ignores the -$base filename as well. Otherwise all path components are assumed to be -directories. - -If $path is absolute, it is cleaned up and returned using L. - -Based on code written by Shigio Yamaguchi. - -No checks against the filesystem are made. - -=cut - -sub rel2abs($;$;) { +sub rel2abs { my ($self,$path,$base ) = @_; if ( ! $self->file_name_is_absolute( $path ) ) { @@ -378,10 +328,10 @@ sub rel2abs($;$;) { $base = $self->canonpath( $base ) ; } - my ( undef, $path_directories, $path_file ) = - $self->splitpath( $path, 1 ) ; + my ( $path_directories, $path_file ) = + ($self->splitpath( $path, 1 ))[1,2] ; - my ( $base_volume, $base_directories, undef ) = + my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ; $path = $self->catpath( diff --git a/contrib/perl5/lib/FileHandle.pm b/contrib/perl5/lib/FileHandle.pm index 34c3475d9c41..5eb3a89adcd7 100644 --- a/contrib/perl5/lib/FileHandle.pm +++ b/contrib/perl5/lib/FileHandle.pm @@ -238,12 +238,12 @@ See L. =item $fh->getline This works like <$fh> described in L -except that it's more readable and can be safely called in an -array context but still returns just one line. +except that it's more readable and can be safely called in a +list context but still returns just one line. =item $fh->getlines -This works like <$fh> when called in an array context to +This works like <$fh> when called in a list context to read all the remaining lines in a file, except that it's more readable. It will also croak() if accidentally called in a scalar context. diff --git a/contrib/perl5/lib/Getopt/Long.pm b/contrib/perl5/lib/Getopt/Long.pm index f474c7c4a978..472527d4a7b9 100644 --- a/contrib/perl5/lib/Getopt/Long.pm +++ b/contrib/perl5/lib/Getopt/Long.pm @@ -2,17 +2,17 @@ package Getopt::Long; -# RCS Status : $Id: GetoptLong.pl,v 2.24 2000-03-14 21:28:52+01 jv Exp $ +# RCS Status : $Id: GetoptLong.pl,v 2.26 2001-01-31 10:20:29+01 jv Exp $ # Author : Johan Vromans # Created On : Tue Sep 11 15:00:12 1990 # Last Modified By: Johan Vromans -# Last Modified On: Tue Mar 14 21:28:40 2000 -# Update Count : 721 +# Last Modified On: Sat Jan 6 17:12:27 2001 +# Update Count : 748 # Status : Released ################ Copyright ################ -# This program is Copyright 1990,2000 by Johan Vromans. +# This program is Copyright 1990,2001 by Johan Vromans. # This program is free software; you can redistribute it and/or # modify it under the terms of the Perl Artistic License or the # GNU General Public License as published by the Free Software @@ -30,19 +30,24 @@ package Getopt::Long; ################ Module Preamble ################ +use 5.004; + use strict; -BEGIN { - require 5.004; - use Exporter (); - use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - $VERSION = "2.23"; +use vars qw($VERSION $VERSION_STRING); +$VERSION = 2.25; +$VERSION_STRING = "2.25"; - @ISA = qw(Exporter); +use Exporter; +use AutoLoader qw(AUTOLOAD); + +use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); +@ISA = qw(Exporter); +%EXPORT_TAGS = qw(); +BEGIN { + # Init immediately so their contents can be used in the 'use vars' below. @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER); - %EXPORT_TAGS = qw(); @EXPORT_OK = qw(); - use AutoLoader qw(AUTOLOAD); } # User visible variables. @@ -52,7 +57,7 @@ use vars qw($error $debug $major_version $minor_version); use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order $passthrough); # Official invisible variables. -use vars qw($genprefix $caller); +use vars qw($genprefix $caller $gnu_compat); # Public subroutines. sub Configure (@); @@ -89,6 +94,27 @@ sub ConfigDefaults () { $error = 0; # error tally $ignorecase = 1; # ignore case when matching options $passthrough = 0; # leave unrecognized options alone + $gnu_compat = 0; # require --opt=val if value is optional +} + +# Override import. +sub import { + my $pkg = shift; # package + my @syms = (); # symbols to import + my @config = (); # configuration + my $dest = \@syms; # symbols first + for ( @_ ) { + if ( $_ eq ':config' ) { + $dest = \@config; # config next + next; + } + push (@$dest, $_); # push + } + # Hide one level and call super. + local $Exporter::ExportLevel = 1; + $pkg->SUPER::import(@syms); + # And configure. + Configure (@config) if @config; } ################ Initialization ################ @@ -100,6 +126,87 @@ sub ConfigDefaults () { ConfigDefaults(); +################ OO Interface ################ + +package Getopt::Long::Parser; + +# NOTE: The object oriented routines use $error for thread locking. +my $_lock = sub { + lock ($Getopt::Long::error) if $] >= 5.005 +}; + +# Store a copy of the default configuration. Since ConfigDefaults has +# just been called, what we get from Configure is the default. +my $default_config = do { + &$_lock; + Getopt::Long::Configure () +}; + +sub new { + my $that = shift; + my $class = ref($that) || $that; + my %atts = @_; + + # Register the callers package. + my $self = { caller_pkg => (caller)[0] }; + + bless ($self, $class); + + # Process config attributes. + if ( defined $atts{config} ) { + &$_lock; + my $save = Getopt::Long::Configure ($default_config, @{$atts{config}}); + $self->{settings} = Getopt::Long::Configure ($save); + delete ($atts{config}); + } + # Else use default config. + else { + $self->{settings} = $default_config; + } + + if ( %atts ) { # Oops + Getopt::Long::Croak(__PACKAGE__.": unhandled attributes: ". + join(" ", sort(keys(%atts)))); + } + + $self; +} + +sub configure { + my ($self) = shift; + + &$_lock; + + # Restore settings, merge new settings in. + my $save = Getopt::Long::Configure ($self->{settings}, @_); + + # Restore orig config and save the new config. + $self->{settings} = Configure ($save); +} + +sub getoptions { + my ($self) = shift; + + &$_lock; + + # Restore config settings. + my $save = Getopt::Long::Configure ($self->{settings}); + + # Call main routine. + my $ret = 0; + $Getopt::Long::caller = $self->{caller_pkg}; + eval { $ret = Getopt::Long::GetOptions (@_); }; + + # Restore saved settings. + Getopt::Long::Configure ($save); + + # Handle errors and return value. + die ($@) if $@; + return $ret; +} + +package Getopt::Long; + ################ Package return ################ 1; @@ -108,12 +215,12 @@ __END__ ################ AutoLoading subroutines ################ -# RCS Status : $Id: GetoptLongAl.pl,v 2.27 2000-03-17 09:07:26+01 jv Exp $ +# RCS Status : $Id: GetoptLongAl.pl,v 2.30 2001-01-31 10:21:11+01 jv Exp $ # Author : Johan Vromans # Created On : Fri Mar 27 11:50:30 1998 # Last Modified By: Johan Vromans -# Last Modified On: Fri Mar 17 09:00:09 2000 -# Update Count : 55 +# Last Modified On: Tue Dec 26 18:01:16 2000 +# Update Count : 98 # Status : Released sub GetOptions { @@ -137,13 +244,14 @@ sub GetOptions { print STDERR ("GetOpt::Long $Getopt::Long::VERSION ", "called from package \"$pkg\".", "\n ", - 'GetOptionsAl $Revision: 2.27 $ ', + 'GetOptionsAl $Revision: 2.30 $ ', "\n ", "ARGV: (@ARGV)", "\n ", "autoabbrev=$autoabbrev,". "bundling=$bundling,", "getopt_compat=$getopt_compat,", + "gnu_compat=$gnu_compat,", "order=$order,", "\n ", "ignorecase=$ignorecase,", @@ -200,7 +308,7 @@ sub GetOptions { next; } - # Match option spec. Allow '?' as an alias. + # Match option spec. Allow '?' as an alias only. if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?([!~+]|[=:][infse][@%]?)?$/ ) { $error .= "Error in option spec: \"$opt\"\n"; next; @@ -208,14 +316,24 @@ sub GetOptions { my ($o, $c, $a) = ($1, $5); $c = '' unless defined $c; + # $linko keeps track of the primary name the user specified. + # This name will be used for the internal or external linkage. + # In other words, if the user specifies "FoO|BaR", it will + # match any case combinations of 'foo' and 'bar', but if a global + # variable needs to be set, it will be $opt_FoO in the exact case + # as specified. + my $linko; + if ( ! defined $o ) { # empty -> '-' option - $opctl{$o = ''} = $c; + $linko = $o = ''; + $opctl{''} = $c; + $bopctl{''} = $c if $bundling; } else { # Handle alias names my @o = split (/\|/, $o); - my $linko = $o = $o[0]; + $linko = $o = $o[0]; # Force an alias if the option name is not locase. $a = $o unless $o eq lc($o); $o = lc ($o) @@ -254,18 +372,18 @@ sub GetOptions { $a = $_; } } - $o = $linko; } # If no linkage is supplied in the @optionlist, copy it from # the userlinkage if available. if ( defined $userlinkage ) { unless ( @optionlist > 0 && ref($optionlist[0]) ) { - if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) { - print STDERR ("=> found userlinkage for \"$o\": ", - "$userlinkage->{$o}\n") + if ( exists $userlinkage->{$linko} && + ref($userlinkage->{$linko}) ) { + print STDERR ("=> found userlinkage for \"$linko\": ", + "$userlinkage->{$linko}\n") if $debug; - unshift (@optionlist, $userlinkage->{$o}); + unshift (@optionlist, $userlinkage->{$linko}); } else { # Do nothing. Being undefined will be handled later. @@ -276,13 +394,13 @@ sub GetOptions { # Copy the linkage. If omitted, link to global variable. if ( @optionlist > 0 && ref($optionlist[0]) ) { - print STDERR ("=> link \"$o\" to $optionlist[0]\n") + print STDERR ("=> link \"$linko\" to $optionlist[0]\n") if $debug; if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) { - $linkage{$o} = shift (@optionlist); + $linkage{$linko} = shift (@optionlist); } elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) { - $linkage{$o} = shift (@optionlist); + $linkage{$linko} = shift (@optionlist); $opctl{$o} .= '@' if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/; $bopctl{$o} .= '@' @@ -290,7 +408,7 @@ sub GetOptions { $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/; } elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) { - $linkage{$o} = shift (@optionlist); + $linkage{$linko} = shift (@optionlist); $opctl{$o} .= '%' if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/; $bopctl{$o} .= '%' @@ -304,22 +422,22 @@ sub GetOptions { else { # Link to global $opt_XXX variable. # Make sure a valid perl identifier results. - my $ov = $o; + my $ov = $linko; $ov =~ s/\W/_/g; if ( $c =~ /@/ ) { - print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n") + print STDERR ("=> link \"$linko\" to \@$pkg","::opt_$ov\n") if $debug; - eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;"); + eval ("\$linkage{\$linko} = \\\@".$pkg."::opt_$ov;"); } elsif ( $c =~ /%/ ) { - print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n") + print STDERR ("=> link \"$linko\" to \%$pkg","::opt_$ov\n") if $debug; - eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;"); + eval ("\$linkage{\$linko} = \\\%".$pkg."::opt_$ov;"); } else { - print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n") + print STDERR ("=> link \"$linko\" to \$$pkg","::opt_$ov\n") if $debug; - eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;"); + eval ("\$linkage{\$linko} = \\\$".$pkg."::opt_$ov;"); } } } @@ -382,7 +500,11 @@ sub GetOptions { next unless defined $opt; if ( defined $arg ) { - $opt = $aliases{$opt} if defined $aliases{$opt}; + if ( defined $aliases{$opt} ) { + print STDERR ("=> alias \"$opt\" -> \"$aliases{$opt}\"\n") + if $debug; + $opt = $aliases{$opt}; + } if ( defined $linkage{$opt} ) { print STDERR ("=> ref(\$L{$opt}) -> ", @@ -543,7 +665,8 @@ sub FindOption ($$$$$$$) { print STDERR ("=> find \"$opt\", prefix=\"$prefix\"\n") if $debug; - return (0) unless $opt =~ /^$prefix(.*)$/s; + return 0 unless $opt =~ /^$prefix(.*)$/s; + return 0 if $opt eq "-" && !defined $opctl->{""}; $opt = $+; my ($starter) = $1; @@ -572,7 +695,7 @@ sub FindOption ($$$$$$$) { if ( $bundling && $starter eq '-' ) { # Unbundle single letter option. - $rest = substr ($tryopt, 1); + $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : ""; $tryopt = substr ($tryopt, 0, 1); $tryopt = lc ($tryopt) if $ignorecase > 1; print STDERR ("=> $starter$tryopt unbundled from ", @@ -646,7 +769,7 @@ sub FindOption ($$$$$$$) { } # Apparently valid. $opt = $tryopt; - print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug; + print STDERR ("=> found \"$type\" for \"", $opt, "\"\n") if $debug; #### Determine argument status #### @@ -675,7 +798,16 @@ sub FindOption ($$$$$$$) { ($mand, $type, $dsttype, $key) = $type =~ /^(.)(.)([@%]?)$/; # Check if there is an option argument available. - if ( defined $optarg ? ($optarg eq '') + if ( $gnu_compat ) { + return (1, $opt, $optarg, $dsttype, $incr, $key) + if defined $optarg; + return (1, $opt, $type eq "s" ? '' : 0, $dsttype, $incr, $key) + if $mand eq ':'; + } + + # Check if there is an option argument available. + if ( defined $optarg + ? ($optarg eq '') : !(defined $rest || @ARGV > 0) ) { # Complain if this option needs an argument. if ( $mand eq "=" ) { @@ -684,10 +816,7 @@ sub FindOption ($$$$$$$) { $error++; undef $opt; } - if ( $mand eq ":" ) { - $arg = $type eq "s" ? '' : 0; - } - return (1, $opt,$arg,$dsttype,$incr,$key); + return (1, $opt, $type eq "s" ? '' : 0, $dsttype, $incr, $key); } # Get (possibly optional) argument. @@ -795,12 +924,12 @@ sub Configure (@) { my $prevconfig = [ $error, $debug, $major_version, $minor_version, $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order, - $passthrough, $genprefix ]; + $gnu_compat, $passthrough, $genprefix ]; if ( ref($options[0]) eq 'ARRAY' ) { ( $error, $debug, $major_version, $minor_version, $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order, - $passthrough, $genprefix ) = @{shift(@options)}; + $gnu_compat, $passthrough, $genprefix ) = @{shift(@options)}; } my $opt; @@ -811,8 +940,13 @@ sub Configure (@) { $action = 0; $try = $+; } - if ( $try eq 'default' or $try eq 'defaults' ) { - ConfigDefaults () if $action; + if ( ($try eq 'default' or $try eq 'defaults') && $action ) { + ConfigDefaults (); + } + elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) { + local $ENV{POSIXLY_CORRECT}; + $ENV{POSIXLY_CORRECT} = 1 if $action; + ConfigDefaults (); } elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) { $autoabbrev = $action; @@ -820,6 +954,17 @@ sub Configure (@) { elsif ( $try eq 'getopt_compat' ) { $getopt_compat = $action; } + elsif ( $try eq 'gnu_getopt' ) { + if ( $action ) { + $gnu_compat = 1; + $bundling = 1; + $getopt_compat = 0; + $permute = 1; + } + } + elsif ( $try eq 'gnu_compat' ) { + $gnu_compat = $action; + } elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) { $ignorecase = $action; } @@ -841,14 +986,14 @@ sub Configure (@) { elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) { $passthrough = $action; } - elsif ( $try =~ /^prefix=(.+)$/ ) { + elsif ( $try =~ /^prefix=(.+)$/ && $action ) { $genprefix = $1; # Turn into regexp. Needs to be parenthesized! $genprefix = "(" . quotemeta($genprefix) . ")"; eval { '' =~ /$genprefix/; }; Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@; } - elsif ( $try =~ /^prefix_pattern=(.+)$/ ) { + elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) { $genprefix = $1; # Parenthesize if needed. $genprefix = "(" . $genprefix . ")" @@ -930,7 +1075,7 @@ could use the more descriptive C<--long>. To distinguish between a bundle of single-character options and a long one, two dashes are used to precede the option name. Early implementations of long options used a plus C<+> instead. Also, option values could be specified either -like +like --size=24 @@ -943,7 +1088,7 @@ The C<+> form is now obsolete and strongly deprecated. =head1 Getting Started with Getopt::Long Getopt::Long is the Perl5 successor of C. This was -the firs Perl module that provided support for handling the new style +the first Perl module that provided support for handling the new style of command line options, hence the name Getopt::Long. This module also supports single-character options and bundling. In this case, the options are restricted to alphabetic characters only, and the @@ -1166,11 +1311,11 @@ requires a least C<--hea> and C<--hei> for the head and height options. =head2 Summary of Option Specifications Each option specifier consists of two parts: the name specification -and the argument specification. +and the argument specification. The name specification contains the name of the option, optionally followed by a list of alternative names separated by vertical bar -characters. +characters. length option name is "length" length|size|l name is "length", aliases are "size" and "l" @@ -1243,6 +1388,24 @@ considered an option on itself. =head1 Advanced Possibilities +=head2 Object oriented interface + +Getopt::Long can be used in an object oriented way as well: + + use Getopt::Long; + $p = new Getopt::Long::Parser; + $p->configure(...configuration options...); + if ($p->getoptions(...options descriptions...)) ... + +Configuration options can be passed to the constructor: + + $p = new Getopt::Long::Parser + config => [...configuration options...]; + +For thread safety, each method call will acquire an exclusive lock to +the Getopt::Long module. So don't call these methods from a callback +routine! + =head2 Documentation and help texts Getopt::Long encourages the use of Pod::Usage to produce help @@ -1365,7 +1528,7 @@ options, -vax -would set C, C and C, but +would set C, C and C, but --vax @@ -1398,13 +1561,18 @@ It goes without saying that bundling can be quite confusing. =head2 The lonesome dash -Some applications require the option C<-> (that's a lone dash). This -can be achieved by adding an option specification with an empty name: +Normally, a lone dash C<-> on the command line will not be considered +an option. Option processing will terminate (unless "permute" is +configured) and the dash will be left in C<@ARGV>. + +It is possible to get special treatment for a lone dash. This can be +achieved by adding an option specification with an empty name, for +example: GetOptions ('' => \$stdio); -A lone dash on the command line will now be legal, and set options -variable C<$stdio>. +A lone dash on the command line will now be a legal option, and using +it will set variable C<$stdio>. =head2 Argument call-back @@ -1423,8 +1591,8 @@ When applied to the following command line: arg1 --width=72 arg2 --width=60 arg3 -This will call -C while C<$width> is C<80>, +This will call +C while C<$width> is C<80>, C while C<$width> is C<72>, and C while C<$width> is C<60>. @@ -1436,10 +1604,15 @@ L. Getopt::Long can be configured by calling subroutine Getopt::Long::Configure(). This subroutine takes a list of quoted -strings, each specifying a configuration option to be set, e.g. -C, or reset, e.g. C. Case does not +strings, each specifying a configuration option to be enabled, e.g. +C, or disabled, e.g. C. Case does not matter. Multiple calls to Configure() are possible. +Alternatively, as of version 2.24, the configuration options may be +passed together with the C statement: + + use Getopt::Long qw(:config no_ignore_case bundling); + The following options are available: =over 12 @@ -1449,34 +1622,53 @@ The following options are available: This option causes all configuration options to be reset to their default values. +=item posix_default + +This option causes all configuration options to be reset to their +default values as if the environment variable POSIXLY_CORRECT had +been set. + =item auto_abbrev Allow option names to be abbreviated to uniqueness. -Default is set unless environment variable -POSIXLY_CORRECT has been set, in which case C is reset. +Default is enabled unless environment variable +POSIXLY_CORRECT has been set, in which case C is disabled. =item getopt_compat Allow C<+> to start options. -Default is set unless environment variable -POSIXLY_CORRECT has been set, in which case C is reset. +Default is enabled unless environment variable +POSIXLY_CORRECT has been set, in which case C is disabled. + +=item gnu_compat + +C controls whether C<--opt=> is allowed, and what it should +do. Without C, C<--opt=> gives an error. With C, +C<--opt=> will give option C and empty value. +This is the way GNU getopt_long() does it. + +=item gnu_getopt + +This is a short way of setting C C C +C. With C, command line handling should be +fully compatible with GNU getopt_long(). =item require_order Whether command line arguments are allowed to be mixed with options. -Default is set unless environment variable -POSIXLY_CORRECT has been set, in which case C is reset. +Default is disabled unless environment variable +POSIXLY_CORRECT has been set, in which case C is enabled. See also C, which is the opposite of C. =item permute Whether command line arguments are allowed to be mixed with options. -Default is set unless environment variable -POSIXLY_CORRECT has been set, in which case C is reset. +Default is enabled unless environment variable +POSIXLY_CORRECT has been set, in which case C is disabled. Note that C is the opposite of C. -If C is set, this means that +If C is enabled, this means that --foo arg1 --bar arg2 arg3 @@ -1493,7 +1685,7 @@ processed. The only exception is when C<--> is used: will call the call-back routine for arg1 and arg2, and terminate GetOptions() leaving C<"arg2"> in C<@ARGV>. -If C is set, options processing +If C is enabled, options processing terminates when the first non-option is encountered. --foo arg1 --bar arg2 arg3 @@ -1502,40 +1694,44 @@ is equivalent to --foo -- arg1 --bar arg2 arg3 -=item bundling (default: reset) +If C is also enabled, options processing will terminate +at the first unrecognized option, or non-option, whichever comes +first. -Setting this option will allow single-character options to be bundled. +=item bundling (default: disabled) + +Enabling this option will allow single-character options to be bundled. To distinguish bundles from long option names, long options I be introduced with C<--> and single-character options (and bundles) with C<->. -Note: resetting C also resets C. +Note: disabling C also disables C. -=item bundling_override (default: reset) +=item bundling_override (default: disabled) -If C is set, bundling is enabled as with -C but now long option names override option bundles. +If C is enabled, bundling is enabled as with +C but now long option names override option bundles. -Note: resetting C also resets C. +Note: disabling C also disables C. B Using option bundling can easily lead to unexpected results, especially when mixing long options and bundles. Caveat emptor. -=item ignore_case (default: set) +=item ignore_case (default: enabled) -If set, case is ignored when matching long option names. Single +If enabled, case is ignored when matching long option names. Single character options will be treated case-sensitive. -Note: resetting C also resets C. +Note: disabling C also disables C. -=item ignore_case_always (default: reset) +=item ignore_case_always (default: disabled) When bundling is in effect, case is ignored on single-character -options also. +options also. -Note: resetting C also resets C. +Note: disabling C also disables C. -=item pass_through (default: reset) +=item pass_through (default: disabled) Options that are unknown, ambiguous or supplied with an invalid option value are passed through in C<@ARGV> instead of being flagged as @@ -1543,7 +1739,9 @@ errors. This makes it possible to write wrapper scripts that process only part of the user supplied command line arguments, and pass the remaining options to some other program. -This can be very confusing, especially when C is also set. +If C is enabled, options processing will terminate at +the first unrecognized option, or non-option, whichever comes first. +However, if C is enabled instead, results can become confusing. =item prefix @@ -1556,9 +1754,9 @@ A Perl pattern that identifies the strings that introduce options. Default is C<(--|-|\+)> unless environment variable POSIXLY_CORRECT has been set, in which case it is C<(--|-)>. -=item debug (default: reset) +=item debug (default: disabled) -Enable copious debugging output. +Enable debugging output. =back @@ -1569,11 +1767,10 @@ signalled using die() and will terminate the calling program unless the call to Getopt::Long::GetOptions() was embedded in C, or die() was trapped using C<$SIG{__DIE__}>. -A return value of 1 (true) indicates success. - -A return status of 0 (false) indicates that the function detected one -or more errors during option parsing. These errors are signalled using -warn() and can be trapped with C<$SIG{__WARN__}>. +GetOptions returns true to indicate success. +It returns false when the function detected one or more errors during +option parsing. These errors are signalled using warn() and can be +trapped with C<$SIG{__WARN__}>. Errors that can't happen are signalled using Carp::croak(). @@ -1629,21 +1826,44 @@ Now the command line may look like: Note that to terminate options processing still requires a double dash C<-->. -GetOptions() will not interpret a leading C<"<>"> as option starters -if the next argument is a reference. To force C<"<"> and C<">"> as -option starters, use C<"><">. Confusing? Well, B" >> as option starters +if the next argument is a reference. To force C<< "<" >> and C<< ">" >> as +option starters, use C<< "><" >>. Confusing? Well, B anyway. =head2 Configuration variables Previous versions of Getopt::Long used variables for the purpose of -configuring. Although manipulating these variables still work, it -is strongly encouraged to use the new C routine. Besides, it -is much easier. +configuring. Although manipulating these variables still work, it is +strongly encouraged to use the C routine that was introduced +in version 2.17. Besides, it is much easier. + +=head1 Trouble Shooting + +=head2 Warning: Ignoring '!' modifier for short option + +This warning is issued when the '!' modifier is applied to a short +(one-character) option and bundling is in effect. E.g., + + Getopt::Long::Configure("bundling"); + GetOptions("foo|f!" => \$foo); + +Note that older Getopt::Long versions did not issue a warning, because +the '!' modifier was applied to the first name only. This bug was +fixed in 2.22. + +Solution: separate the long and short names and apply the '!' to the +long names only, e.g., + + GetOptions("foo!" => \$foo, "f" => \$foo); + +=head2 GetOptions does not return a false result when an option is not supplied + +That's why they're called 'options'. =head1 AUTHOR -Johan Vromans Ejvromans@squirrel.nlE +Johan Vromans =head1 COPYRIGHT AND DISCLAIMER @@ -1660,12 +1880,11 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. If you do not have a copy of the GNU General Public License write to -the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, +the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. =cut # Local Variables: -# mode: perl # eval: (load-file "pod.el") # End: diff --git a/contrib/perl5/lib/IPC/Open3.pm b/contrib/perl5/lib/IPC/Open3.pm index 99709ac0ca76..5c9c69ad0287 100644 --- a/contrib/perl5/lib/IPC/Open3.pm +++ b/contrib/perl5/lib/IPC/Open3.pm @@ -44,12 +44,15 @@ by an autogenerated filehandle. If so, you must pass a valid lvalue in the parameter slot so it can be overwritten in the caller, or an exception will be raised. +The filehandles may also be integers, in which case they are understood +as file descriptors. + open3() returns the process ID of the child process. It doesn't return on failure: it just raises an exception matching C. However, C failures in the child are not detected. You'll have to trap SIGPIPE yourself. -open2() does not wait for and reap the child process after it exits. +open3() does not wait for and reap the child process after it exits. Except for short programs where it's acceptable to let the operating system take care of this, you need to do this yourself. This is normally as simple as calling C when you're done with the process. @@ -84,6 +87,7 @@ The order of arguments differs from that of open2(). # fixed for 5.001 by Ulrich Kunitz # ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career # fixed for autovivving FHs, tchrist again +# allow fd numbers to be used, by Frank Tobin # # $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $ # @@ -136,6 +140,15 @@ sub xclose { close $_[0] or croak "$Me: close($_[0]) failed: $!"; } +sub fh_is_fd { + return $_[0] =~ /\A=?(\d+)\z/; +} + +sub xfileno { + return $1 if $_[0] =~ /\A=?(\d+)\z/; # deal with fh just being an fd + return fileno $_[0]; +} + my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32'; sub _open3 { @@ -164,9 +177,9 @@ sub _open3 { $dup_err = ($dad_err =~ s/^[<>]&//); # force unqualified filehandles into caller's package - $dad_wtr = qualify $dad_wtr, $package; - $dad_rdr = qualify $dad_rdr, $package; - $dad_err = qualify $dad_err, $package; + $dad_wtr = qualify $dad_wtr, $package unless fh_is_fd($dad_wtr); + $dad_rdr = qualify $dad_rdr, $package unless fh_is_fd($dad_rdr); + $dad_err = qualify $dad_err, $package unless fh_is_fd($dad_err); my $kid_rdr = gensym; my $kid_wtr = gensym; @@ -181,20 +194,20 @@ sub _open3 { # If she wants to dup the kid's stderr onto her stdout I need to # save a copy of her stdout before I put something else there. if ($dad_rdr ne $dad_err && $dup_err - && fileno($dad_err) == fileno(STDOUT)) { + && xfileno($dad_err) == fileno(STDOUT)) { my $tmp = gensym; xopen($tmp, ">&$dad_err"); $dad_err = $tmp; } if ($dup_wtr) { - xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != fileno($dad_wtr); + xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr); } else { xclose $dad_wtr; xopen \*STDIN, "<&=" . fileno $kid_rdr; } if ($dup_rdr) { - xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != fileno($dad_rdr); + xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr); } else { xclose $dad_rdr; xopen \*STDOUT, ">&=" . fileno $kid_wtr; @@ -204,8 +217,8 @@ sub _open3 { # I have to use a fileno here because in this one case # I'm doing a dup but the filehandle might be a reference # (from the special case above). - xopen \*STDERR, ">&" . fileno $dad_err - if fileno(STDERR) != fileno($dad_err); + xopen \*STDERR, ">&" . xfileno($dad_err) + if fileno(STDERR) != xfileno($dad_err); } else { xclose $dad_err; xopen \*STDERR, ">&=" . fileno $kid_err; diff --git a/contrib/perl5/lib/Math/BigFloat.pm b/contrib/perl5/lib/Math/BigFloat.pm index d8d643ca3e31..1eefac2d79ea 100644 --- a/contrib/perl5/lib/Math/BigFloat.pm +++ b/contrib/perl5/lib/Math/BigFloat.pm @@ -4,6 +4,7 @@ use Math::BigInt; use Exporter; # just for use to be happy @ISA = (Exporter); +$VERSION = '0.02'; use overload '+' => sub {new Math::BigFloat &fadd}, @@ -12,9 +13,12 @@ use overload '<=>' => sub {$_[2]? fcmp($_[1],${$_[0]}) : fcmp(${$_[0]},$_[1])}, 'cmp' => sub {$_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])}, '*' => sub {new Math::BigFloat &fmul}, -'/' => sub {new Math::BigFloat +'/' => sub {new Math::BigFloat $_[2]? scalar fdiv($_[1],${$_[0]}) : scalar fdiv(${$_[0]},$_[1])}, +'%' => sub {new Math::BigFloat + $_[2]? scalar fmod($_[1],${$_[0]}) : + scalar fmod(${$_[0]},$_[1])}, 'neg' => sub {new Math::BigFloat &fneg}, 'abs' => sub {new Math::BigFloat &fabs}, @@ -43,12 +47,15 @@ sub stringify { my $e = $1; my $ln = length($n); - if ($e > 0) { - $n .= "0" x $e . '.'; - } elsif (abs($e) < $ln) { - substr($n, $ln + $e, 0) = '.'; - } else { - $n = '.' . ("0" x (abs($e) - $ln)) . $n; + if ( defined $e ) + { + if ($e > 0) { + $n .= "0" x $e . '.'; + } elsif (abs($e) < $ln) { + substr($n, $ln + $e, 0) = '.'; + } else { + $n = '.' . ("0" x (abs($e) - $ln)) . $n; + } } $n = "-$n" if $minus; @@ -85,6 +92,7 @@ sub fnorm { #(string) return fnum_str # normalize number -- for internal use sub norm { #(mantissa, exponent) return fnum_str local($_, $exp) = @_; + $exp = 0 unless defined $exp; if ($_ eq 'NaN') { 'NaN'; } else { @@ -140,7 +148,7 @@ sub fadd { #(fnum_str, fnum_str) return fnum_str # subtraction sub fsub { #(fnum_str, fnum_str) return fnum_str - fadd($_[$[],fneg($_[$[+1])); + fadd($_[$[],fneg($_[$[+1])); } # division @@ -164,6 +172,27 @@ sub fdiv #(fnum_str, fnum_str[,scale]) return fnum_str } } +# modular division +# args are dividend, divisor +sub fmod #(fnum_str, fnum_str) return fnum_str +{ + local($x,$y) = (fnorm($_[$[]),fnorm($_[$[+1])); + if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0E+0') { + 'NaN'; + } else { + local($xm,$xe) = split('E',$x); + local($ym,$ye) = split('E',$y); + if ( $xe < $ye ) + { + $ym .= ('0' x ($ye-$xe)); + } + else + { + $xm .= ('0' x ($xe-$ye)); + } + &norm(Math::BigInt::bmod($xm,$ym)); + } +} # round int $q based on fraction $r/$base using $rnd_mode sub round { #(int_str, int_str, int_str) return int_str local($q,$r,$base) = @_; @@ -174,12 +203,14 @@ sub round { #(int_str, int_str, int_str) return int_str } else { local($cmp) = Math::BigInt::bcmp(Math::BigInt::bmul($r,'+2'),$base); if ( $cmp < 0 || - ($cmp == 0 && - ( $rnd_mode eq 'zero' || + ($cmp == 0 && ( + ($rnd_mode eq 'zero' ) || ($rnd_mode eq '-inf' && (substr($q,$[,1) eq '+')) || ($rnd_mode eq '+inf' && (substr($q,$[,1) eq '-')) || - ($rnd_mode eq 'even' && $q =~ /[24680]$/) || - ($rnd_mode eq 'odd' && $q =~ /[13579]$/) )) ) { + ($rnd_mode eq 'even' && $q =~ /[24680]$/ ) || + ($rnd_mode eq 'odd' && $q =~ /[13579]$/ ) ) + ) + ) { $q; # round down } else { Math::BigInt::badd($q, ((substr($q,$[,1) eq '-') ? '-1' : '+1')); @@ -199,7 +230,7 @@ sub fround { #(fnum_str, scale) return fnum_str $x; } else { &norm(&round(substr($xm,$[,$scale+1), - "+0".substr($xm,$[+$scale+1,1),"+10"), + "+0".substr($xm,$[+$scale+1),"+1"."0" x length(substr($xm,$[+$scale+1))), $xe+length($xm)-$scale-1); } } @@ -223,15 +254,17 @@ sub ffround { #(fnum_str, scale) return fnum_str # normalized "-0" to &round when rounding -0.006 (for # example), purely so &round won't lose the sign. &norm(&round(substr($xm,$[,1).'0', - "+0".substr($xm,$[+1,1),"+10"), $scale); + "+0".substr($xm,$[+1), + "+1"."0" x length(substr($xm,$[+1))), $scale); } else { &norm(&round(substr($xm,$[,$xe), - "+0".substr($xm,$[+$xe,1),"+10"), $scale); + "+0".substr($xm,$[+$xe), + "+1"."0" x length(substr($xm,$[+$xe))), $scale); } } } } - + # compare 2 values returns one of undef, <0, =0, >0 # returns undef if either or both input value are not numbers sub fcmp #(fnum_str, fnum_str) return cond_code @@ -244,9 +277,17 @@ sub fcmp #(fnum_str, fnum_str) return cond_code if ($xm eq '+0' || $ym eq '+0') { return $xm <=> $ym; } - ord($y) <=> ord($x) - || ($xe <=> $ye) * (substr($x,$[,1).'1') - || Math::BigInt::cmp($xm,$ym); + if ( $xe < $ye ) # adjust the exponents to be equal + { + $ym .= '0' x ($ye - $xe); + $ye = $xe; + } + elsif ( $ye < $xe ) # same here + { + $xm .= '0' x ($xe - $ye); + $xe = $ye; + } + return Math::BigInt::cmp($xm,$ym); } } @@ -286,6 +327,7 @@ Math::BigFloat - Arbitrary length float math package $f->fsub(NSTR) return NSTR subtraction $f->fmul(NSTR) return NSTR multiplication $f->fdiv(NSTR[,SCALE]) returns NSTR division to SCALE places + $f->fmod(NSTR) returns NSTR modular remainder $f->fneg() return NSTR negation $f->fabs() return NSTR absolute value $f->fcmp(NSTR) return CODE compare undef,<0,=0,>0 @@ -313,7 +355,7 @@ have embedded whitespace. An input parameter was "Not a Number" or divide by zero or sqrt of negative number. -=item Division is computed to +=item Division is computed to C digits by default. @@ -352,5 +394,5 @@ as follows: =head1 AUTHOR Mark Biggar - +Patches by John Peacock Apr 2001 =cut diff --git a/contrib/perl5/lib/Math/BigInt.pm b/contrib/perl5/lib/Math/BigInt.pm index a43969c2b232..066577d4cc13 100644 --- a/contrib/perl5/lib/Math/BigInt.pm +++ b/contrib/perl5/lib/Math/BigInt.pm @@ -1,4 +1,5 @@ package Math::BigInt; +$VERSION='0.01'; use overload '+' => sub {new Math::BigInt &badd}, @@ -51,6 +52,11 @@ sub import { $zero = 0; +# overcome a floating point problem on certain osnames (posix-bc, os390) +BEGIN { + my $x = 100000.0; + my $use_mult = int($x*1e-5)*1e5 == $x ? 1 : 0; +} # normalize string form of number. Strip leading zeros. Strip any # white space and add a sign, if missing. @@ -227,8 +233,14 @@ sub mul { #(*int_num_array, *int_num_array) return int_num_array ($car, $cty) = (0, $[); for $y (@y) { $prod = $x * $y + ($prod[$cty] || 0) + $car; + if ($use_mult) { $prod[$cty++] = $prod - ($car = int($prod * 1e-5)) * 1e5; + } + else { + $prod[$cty++] = + $prod - ($car = int($prod / 1e5)) * 1e5; + } } $prod[$cty] += $car if $car; $x = shift @prod; @@ -253,12 +265,22 @@ sub bdiv { #(dividend: num_str, divisor: num_str) return num_str if (($dd = int(1e5/($y[$#y]+1))) != 1) { for $x (@x) { $x = $x * $dd + $car; + if ($use_mult) { $x -= ($car = int($x * 1e-5)) * 1e5; + } + else { + $x -= ($car = int($x / 1e5)) * 1e5; + } } push(@x, $car); $car = 0; for $y (@y) { $y = $y * $dd + $car; + if ($use_mult) { $y -= ($car = int($y * 1e-5)) * 1e5; + } + else { + $y -= ($car = int($y / 1e5)) * 1e5; + } } } else { @@ -275,7 +297,12 @@ sub bdiv { #(dividend: num_str, divisor: num_str) return num_str ($car, $bar) = (0,0); for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) { $prd = $q * $y[$y] + $car; + if ($use_mult) { $prd -= ($car = int($prd * 1e-5)) * 1e5; + } + else { + $prd -= ($car = int($prd / 1e5)) * 1e5; + } $x[$x] += 1e5 if ($bar = (($x[$x] -= $prd + $bar) < 0)); } if ($x[$#x] < $car + $bar) { diff --git a/contrib/perl5/lib/Math/Complex.pm b/contrib/perl5/lib/Math/Complex.pm index 1a47f4af5e63..9812513656df 100644 --- a/contrib/perl5/lib/Math/Complex.pm +++ b/contrib/perl5/lib/Math/Complex.pm @@ -5,17 +5,39 @@ # -- Daniel S. Lewart Since Sep 1997 # -require Exporter; package Math::Complex; -use 5.005_64; +our($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $Inf); + +$VERSION = 1.31; + +BEGIN { + unless ($^O eq 'unicosmk') { + my $e = $!; + # We do want an arithmetic overflow, Inf INF inf Infinity:. + undef $Inf unless eval <<'EOE' and $Inf =~ /^inf(?:inity)?$/i; + local $SIG{FPE} = sub {die}; + my $t = CORE::exp 30; + $Inf = CORE::exp $t; +EOE + if (!defined $Inf) { # Try a different method + undef $Inf unless eval <<'EOE' and $Inf =~ /^inf(?:inity)?$/i; + local $SIG{FPE} = sub {die}; + my $t = 1; + $Inf = $t + "1e99999999999999999999999999999999"; +EOE + } + $! = $e; # Clear ERANGE. + } + $Inf = "Inf" if !defined $Inf || !($Inf > 0); # Desperation. +} + use strict; -our($VERSION, @ISA, @EXPORT, %EXPORT_TAGS); +my $i; +my %LOGN; -my ( $i, $ip2, %logn ); - -$VERSION = sprintf("%s", q$Id: Complex.pm,v 1.26 1998/11/01 00:00:00 dsl Exp $ =~ /(\d+\.\d+)/); +require Exporter; @ISA = qw(Exporter); @@ -49,6 +71,7 @@ use overload '*' => \&multiply, '/' => \÷, '**' => \&power, + '==' => \&numeq, '<=>' => \&spaceship, 'neg' => \&negate, '~' => \&conjugate, @@ -66,7 +89,6 @@ use overload # Package "privates" # -my $package = 'Math::Complex'; # Package name my %DISPLAY_FORMAT = ('style' => 'cartesian', 'polar_pretty_print' => 1); my $eps = 1e-14; # Epsilon @@ -227,6 +249,13 @@ sub i () { return $i; } +# +# ip2 +# +# Half of i. +# +sub ip2 () { i / 2 } + # # Attribute access/set routines # @@ -262,7 +291,8 @@ sub update_polar { my ($x, $y) = @{$self->{'cartesian'}}; $self->{p_dirty} = 0; return $self->{'polar'} = [0, 0] if $x == 0 && $y == 0; - return $self->{'polar'} = [CORE::sqrt($x*$x + $y*$y), CORE::atan2($y, $x)]; + return $self->{'polar'} = [CORE::sqrt($x*$x + $y*$y), + CORE::atan2($y, $x)]; } # @@ -342,7 +372,7 @@ sub _divbyzero { if (defined $_[1]) { $mess .= "(Because in the definition of $_[0], the divisor "; - $mess .= "$_[1] " unless ($_[1] eq '0'); + $mess .= "$_[1] " unless ("$_[1]" eq '0'); $mess .= "is 0)\n"; } @@ -416,8 +446,8 @@ sub power { return 1 if $z2 == 0 || $z1 == 1; return 0 if $z1 == 0 && Re($z2) > 0; } - my $w = $inverted ? CORE::exp($z1 * CORE::log($z2)) - : CORE::exp($z2 * CORE::log($z1)); + my $w = $inverted ? &exp($z1 * &log($z2)) + : &exp($z2 * &log($z1)); # If both arguments cartesian, return cartesian, else polar. return $z1->{c_dirty} == 0 && (not ref $z2 or $z2->{c_dirty} == 0) ? @@ -439,6 +469,19 @@ sub spaceship { return $sgn * ($im1 <=> $im2); } +# +# (numeq) +# +# Computes z1 == z2. +# +# (Required in addition to spaceship() because of NaNs.) +sub numeq { + my ($z1, $z2, $inverted) = @_; + my ($re1, $im1) = ref $z1 ? @{$z1->cartesian} : ($z1, 0); + my ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0); + return $re1 == $re2 && $im1 == $im2 ? 1 : 0; +} + # # (negate) # @@ -477,7 +520,13 @@ sub conjugate { # sub abs { my ($z, $rho) = @_; - return $z unless ref $z; + unless (ref $z) { + if (@_ == 2) { + $_[0] = $_[1]; + } else { + return CORE::abs($z); + } + } if (defined $rho) { $z->{'polar'} = [ $rho, ${$z->polar}[1] ]; $z->{p_dirty} = 0; @@ -533,7 +582,8 @@ sub arg { sub sqrt { my ($z) = @_; my ($re, $im) = ref $z ? @{$z->cartesian} : ($z, 0); - return $re < 0 ? cplx(0, CORE::sqrt(-$re)) : CORE::sqrt($re) if $im == 0; + return $re < 0 ? cplx(0, CORE::sqrt(-$re)) : CORE::sqrt($re) + if $im == 0; my ($r, $t) = @{$z->polar}; return (ref $z)->emake(CORE::sqrt($r), $t/2); } @@ -547,9 +597,12 @@ sub sqrt { # sub cbrt { my ($z) = @_; - return $z < 0 ? -CORE::exp(CORE::log(-$z)/3) : ($z > 0 ? CORE::exp(CORE::log($z)/3): 0) + return $z < 0 ? + -CORE::exp(CORE::log(-$z)/3) : + ($z > 0 ? CORE::exp(CORE::log($z)/3): 0) unless ref $z; my ($r, $t) = @{$z->polar}; + return 0 if $r == 0; return (ref $z)->emake(CORE::exp(CORE::log($r)/3), $t/3); } @@ -559,7 +612,7 @@ sub cbrt { # Die on bad root. # sub _rootbad { - my $mess = "Root $_[0] not defined, root must be positive integer.\n"; + my $mess = "Root $_[0] illegal, root rank must be positive integer.\n"; my @up = caller(1); @@ -581,7 +634,8 @@ sub _rootbad { sub root { my ($z, $n) = @_; _rootbad($n) if ($n < 1 or int($n) != $n); - my ($r, $t) = ref $z ? @{$z->polar} : (CORE::abs($z), $z >= 0 ? 0 : pi); + my ($r, $t) = ref $z ? + @{$z->polar} : (CORE::abs($z), $z >= 0 ? 0 : pi); my @root; my $k; my $theta_inc = pit2 / $n; @@ -620,7 +674,7 @@ sub Re { # sub Im { my ($z, $Im) = @_; - return $z unless ref $z; + return 0 unless ref $z; if (defined $Im) { $z->{'cartesian'} = [ ${$z->cartesian}[0], $Im ]; $z->{c_dirty} = 0; @@ -723,9 +777,9 @@ sub log10 { sub logn { my ($z, $n) = @_; $z = cplx($z, 0) unless ref $z; - my $logn = $logn{$n}; - $logn = $logn{$n} = CORE::log($n) unless defined $logn; # Cache log(n) - return CORE::log($z) / $logn; + my $logn = $LOGN{$n}; + $logn = $LOGN{$n} = CORE::log($n) unless defined $logn; # Cache log(n) + return &log($z) / $logn; } # @@ -735,11 +789,14 @@ sub logn { # sub cos { my ($z) = @_; + return CORE::cos($z) unless ref $z; my ($x, $y) = @{$z->cartesian}; my $ey = CORE::exp($y); - my $ey_1 = 1 / $ey; - return (ref $z)->make(CORE::cos($x) * ($ey + $ey_1)/2, - CORE::sin($x) * ($ey_1 - $ey)/2); + my $sx = CORE::sin($x); + my $cx = CORE::cos($x); + my $ey_1 = $ey ? 1 / $ey : $Inf; + return (ref $z)->make($cx * ($ey + $ey_1)/2, + $sx * ($ey_1 - $ey)/2); } # @@ -749,11 +806,14 @@ sub cos { # sub sin { my ($z) = @_; + return CORE::sin($z) unless ref $z; my ($x, $y) = @{$z->cartesian}; my $ey = CORE::exp($y); - my $ey_1 = 1 / $ey; - return (ref $z)->make(CORE::sin($x) * ($ey + $ey_1)/2, - CORE::cos($x) * ($ey - $ey_1)/2); + my $sx = CORE::sin($x); + my $cx = CORE::cos($x); + my $ey_1 = $ey ? 1 / $ey : $Inf; + return (ref $z)->make($sx * ($ey + $ey_1)/2, + $cx * ($ey - $ey_1)/2); } # @@ -763,9 +823,9 @@ sub sin { # sub tan { my ($z) = @_; - my $cz = CORE::cos($z); - _divbyzero "tan($z)", "cos($z)" if (CORE::abs($cz) < $eps); - return CORE::sin($z) / $cz; + my $cz = &cos($z); + _divbyzero "tan($z)", "cos($z)" if $cz == 0; + return &sin($z) / $cz; } # @@ -775,7 +835,7 @@ sub tan { # sub sec { my ($z) = @_; - my $cz = CORE::cos($z); + my $cz = &cos($z); _divbyzero "sec($z)", "cos($z)" if ($cz == 0); return 1 / $cz; } @@ -787,7 +847,7 @@ sub sec { # sub csc { my ($z) = @_; - my $sz = CORE::sin($z); + my $sz = &sin($z); _divbyzero "csc($z)", "sin($z)" if ($sz == 0); return 1 / $sz; } @@ -806,9 +866,9 @@ sub cosec { Math::Complex::csc(@_) } # sub cot { my ($z) = @_; - my $sz = CORE::sin($z); + my $sz = &sin($z); _divbyzero "cot($z)", "sin($z)" if ($sz == 0); - return CORE::cos($z) / $sz; + return &cos($z) / $sz; } # @@ -825,8 +885,11 @@ sub cotan { Math::Complex::cot(@_) } # sub acos { my $z = $_[0]; - return CORE::atan2(CORE::sqrt(1-$z*$z), $z) if (! ref $z) && CORE::abs($z) <= 1; - my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0); + return CORE::atan2(CORE::sqrt(1-$z*$z), $z) + if (! ref $z) && CORE::abs($z) <= 1; + $z = cplx($z, 0) unless ref $z; + my ($x, $y) = @{$z->cartesian}; + return 0 if $x == 1 && $y == 0; my $t1 = CORE::sqrt(($x+1)*($x+1) + $y*$y); my $t2 = CORE::sqrt(($x-1)*($x-1) + $y*$y); my $alpha = ($t1 + $t2)/2; @@ -837,7 +900,7 @@ sub acos { my $u = CORE::atan2(CORE::sqrt(1-$beta*$beta), $beta); my $v = CORE::log($alpha + CORE::sqrt($alpha*$alpha-1)); $v = -$v if $y > 0 || ($y == 0 && $x < -1); - return __PACKAGE__->make($u, $v); + return (ref $z)->make($u, $v); } # @@ -847,8 +910,11 @@ sub acos { # sub asin { my $z = $_[0]; - return CORE::atan2($z, CORE::sqrt(1-$z*$z)) if (! ref $z) && CORE::abs($z) <= 1; - my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0); + return CORE::atan2($z, CORE::sqrt(1-$z*$z)) + if (! ref $z) && CORE::abs($z) <= 1; + $z = cplx($z, 0) unless ref $z; + my ($x, $y) = @{$z->cartesian}; + return 0 if $x == 0 && $y == 0; my $t1 = CORE::sqrt(($x+1)*($x+1) + $y*$y); my $t2 = CORE::sqrt(($x-1)*($x-1) + $y*$y); my $alpha = ($t1 + $t2)/2; @@ -859,7 +925,7 @@ sub asin { my $u = CORE::atan2($beta, CORE::sqrt(1-$beta*$beta)); my $v = -CORE::log($alpha + CORE::sqrt($alpha*$alpha-1)); $v = -$v if $y > 0 || ($y == 0 && $x < -1); - return __PACKAGE__->make($u, $v); + return (ref $z)->make($u, $v); } # @@ -870,11 +936,12 @@ sub asin { sub atan { my ($z) = @_; return CORE::atan2($z, 1) unless ref $z; + my ($x, $y) = ref $z ? @{$z->cartesian} : ($z, 0); + return 0 if $x == 0 && $y == 0; _divbyzero "atan(i)" if ( $z == i); - _divbyzero "atan(-i)" if (-$z == i); - my $log = CORE::log((i + $z) / (i - $z)); - $ip2 = 0.5 * i unless defined $ip2; - return $ip2 * $log; + _logofzero "atan(-i)" if (-$z == i); # -i is a bad file test... + my $log = &log((i + $z) / (i - $z)); + return ip2 * $log; } # @@ -913,10 +980,11 @@ sub acosec { Math::Complex::acsc(@_) } # sub acot { my ($z) = @_; - _divbyzero "acot(0)" if (CORE::abs($z) < $eps); - return ($z >= 0) ? CORE::atan2(1, $z) : CORE::atan2(-1, -$z) unless ref $z; - _divbyzero "acot(i)" if (CORE::abs($z - i) < $eps); - _logofzero "acot(-i)" if (CORE::abs($z + i) < $eps); + _divbyzero "acot(0)" if $z == 0; + return ($z >= 0) ? CORE::atan2(1, $z) : CORE::atan2(-1, -$z) + unless ref $z; + _divbyzero "acot(i)" if ($z - i == 0); + _logofzero "acot(-i)" if ($z + i == 0); return atan(1 / $z); } @@ -937,11 +1005,11 @@ sub cosh { my $ex; unless (ref $z) { $ex = CORE::exp($z); - return ($ex + 1/$ex)/2; + return $ex ? ($ex + 1/$ex)/2 : $Inf; } my ($x, $y) = @{$z->cartesian}; $ex = CORE::exp($x); - my $ex_1 = 1 / $ex; + my $ex_1 = $ex ? 1 / $ex : $Inf; return (ref $z)->make(CORE::cos($y) * ($ex + $ex_1)/2, CORE::sin($y) * ($ex - $ex_1)/2); } @@ -955,12 +1023,15 @@ sub sinh { my ($z) = @_; my $ex; unless (ref $z) { + return 0 if $z == 0; $ex = CORE::exp($z); - return ($ex - 1/$ex)/2; + return $ex ? ($ex - 1/$ex)/2 : "-$Inf"; } my ($x, $y) = @{$z->cartesian}; + my $cy = CORE::cos($y); + my $sy = CORE::sin($y); $ex = CORE::exp($x); - my $ex_1 = 1 / $ex; + my $ex_1 = $ex ? 1 / $ex : $Inf; return (ref $z)->make(CORE::cos($y) * ($ex - $ex_1)/2, CORE::sin($y) * ($ex + $ex_1)/2); } @@ -1016,7 +1087,7 @@ sub cosech { Math::Complex::csch(@_) } sub coth { my ($z) = @_; my $sz = sinh($z); - _divbyzero "coth($z)", "sinh($z)" if ($sz == 0); + _divbyzero "coth($z)", "sinh($z)" if $sz == 0; return cosh($z) / $sz; } @@ -1035,25 +1106,44 @@ sub cotanh { Math::Complex::coth(@_) } sub acosh { my ($z) = @_; unless (ref $z) { - return CORE::log($z + CORE::sqrt($z*$z-1)) if $z >= 1; $z = cplx($z, 0); } my ($re, $im) = @{$z->cartesian}; if ($im == 0) { - return cplx(CORE::log($re + CORE::sqrt($re*$re - 1)), 0) if $re >= 1; - return cplx(0, CORE::atan2(CORE::sqrt(1-$re*$re), $re)) if CORE::abs($re) <= 1; + return CORE::log($re + CORE::sqrt($re*$re - 1)) + if $re >= 1; + return cplx(0, CORE::atan2(CORE::sqrt(1 - $re*$re), $re)) + if CORE::abs($re) < 1; } - return CORE::log($z + CORE::sqrt($z*$z - 1)); + my $t = &sqrt($z * $z - 1) + $z; + # Try Taylor if looking bad (this usually means that + # $z was large negative, therefore the sqrt is really + # close to abs(z), summing that with z...) + $t = 1/(2 * $z) - 1/(8 * $z**3) + 1/(16 * $z**5) - 5/(128 * $z**7) + if $t == 0; + my $u = &log($t); + $u->Im(-$u->Im) if $re < 0 && $im == 0; + return $re < 0 ? -$u : $u; } # # asinh # -# Computes the arc hyperbolic sine asinh(z) = log(z + sqrt(z*z-1)) +# Computes the arc hyperbolic sine asinh(z) = log(z + sqrt(z*z+1)) # sub asinh { my ($z) = @_; - return CORE::log($z + CORE::sqrt($z*$z + 1)); + unless (ref $z) { + my $t = $z + CORE::sqrt($z*$z + 1); + return CORE::log($t) if $t; + } + my $t = &sqrt($z * $z + 1) + $z; + # Try Taylor if looking bad (this usually means that + # $z was large negative, therefore the sqrt is really + # close to abs(z), summing that with z...) + $t = 1/(2 * $z) - 1/(8 * $z**3) + 1/(16 * $z**5) - 5/(128 * $z**7) + if $t == 0; + return &log($t); } # @@ -1067,9 +1157,9 @@ sub atanh { return CORE::log((1 + $z)/(1 - $z))/2 if CORE::abs($z) < 1; $z = cplx($z, 0); } - _divbyzero 'atanh(1)', "1 - $z" if ($z == 1); - _logofzero 'atanh(-1)' if ($z == -1); - return 0.5 * CORE::log((1 + $z) / (1 - $z)); + _divbyzero 'atanh(1)', "1 - $z" if (1 - $z == 0); + _logofzero 'atanh(-1)' if (1 + $z == 0); + return 0.5 * &log((1 + $z) / (1 - $z)); } # @@ -1079,7 +1169,7 @@ sub atanh { # sub asech { my ($z) = @_; - _divbyzero 'asech(0)', $z if ($z == 0); + _divbyzero 'asech(0)', "$z" if ($z == 0); return acosh(1 / $z); } @@ -1108,14 +1198,14 @@ sub acosech { Math::Complex::acsch(@_) } # sub acoth { my ($z) = @_; - _divbyzero 'acoth(0)' if (CORE::abs($z) < $eps); + _divbyzero 'acoth(0)' if ($z == 0); unless (ref $z) { return CORE::log(($z + 1)/($z - 1))/2 if CORE::abs($z) > 1; $z = cplx($z, 0); } - _divbyzero 'acoth(1)', "$z - 1" if (CORE::abs($z - 1) < $eps); - _logofzero 'acoth(-1)', "1 / $z" if (CORE::abs($z + 1) < $eps); - return CORE::log((1 + $z) / ($z - 1)) / 2; + _divbyzero 'acoth(1)', "$z - 1" if ($z - 1 == 0); + _logofzero 'acoth(-1)', "1 + $z" if (1 + $z == 0); + return &log((1 + $z) / ($z - 1)) / 2; } # @@ -1141,8 +1231,8 @@ sub atan2 { ($re2, $im2) = ref $z2 ? @{$z2->cartesian} : ($z2, 0); } if ($im2 == 0) { - return cplx(CORE::atan2($re1, $re2), 0) if $im1 == 0; - return cplx(($im1<=>0) * pip2, 0) if $re2 == 0; + return CORE::atan2($re1, $re2) if $im1 == 0; + return ($im1<=>0) * pip2 if $re2 == 0; } my $w = atan($z1/$z2); my ($u, $v) = ref $w ? @{$w->cartesian} : ($w, 0); @@ -1173,23 +1263,15 @@ sub display_format { my %obj = %{$self->{display_format}}; @display_format{keys %obj} = values %obj; } - if (@_ == 1) { - $display_format{style} = shift; - } else { - my %new = @_; - @display_format{keys %new} = values %new; - } - } else { # Called as a class method - if (@_ = 1) { - $display_format{style} = $self; - } else { - my %new = @_; - @display_format{keys %new} = values %new; - } - undef $self; + } + if (@_ == 1) { + $display_format{style} = shift; + } else { + my %new = @_; + @display_format{keys %new} = values %new; } - if (defined $self) { + if (ref $self) { # Called as an object method $self->{display_format} = { %display_format }; return wantarray ? @@ -1197,6 +1279,7 @@ sub display_format { $self->{display_format}->{style}; } + # Called as a class method %DISPLAY_FORMAT = %display_format; return wantarray ? @@ -1235,67 +1318,58 @@ sub stringify_cartesian { my ($x, $y) = @{$z->cartesian}; my ($re, $im); - $x = int($x + ($x < 0 ? -1 : 1) * $eps) - if int(CORE::abs($x)) != int(CORE::abs($x) + $eps); - $y = int($y + ($y < 0 ? -1 : 1) * $eps) - if int(CORE::abs($y)) != int(CORE::abs($y) + $eps); - - $re = "$x" if CORE::abs($x) >= $eps; - my %format = $z->display_format; my $format = $format{format}; - if ($y == 1) { $im = 'i' } - elsif ($y == -1) { $im = '-i' } - elsif (CORE::abs($y) >= $eps) { - $im = (defined $format ? sprintf($format, $y) : $y) . "i"; + if ($x) { + if ($x =~ /^NaN[QS]?$/i) { + $re = $x; + } else { + if ($x =~ /^-?$Inf$/oi) { + $re = $x; + } else { + $re = defined $format ? sprintf($format, $x) : $x; + } + } + } else { + undef $re; } - my $str = ''; - $str = defined $format ? sprintf($format, $re) : $re - if defined $re; + if ($y) { + if ($y =~ /^(NaN[QS]?)$/i) { + $im = $y; + } else { + if ($y =~ /^-?$Inf$/oi) { + $im = $y; + } else { + $im = + defined $format ? + sprintf($format, $y) : + ($y == 1 ? "" : ($y == -1 ? "-" : $y)); + } + } + $im .= "i"; + } else { + undef $im; + } + + my $str = $re; + if (defined $im) { if ($y < 0) { $str .= $im; - } elsif ($y > 0) { + } elsif ($y > 0 || $im =~ /^NaN[QS]?i$/i) { $str .= "+" if defined $re; $str .= $im; } + } elsif (!defined $re) { + $str = "0"; } return $str; } -# Helper for stringify_polar, a Greatest Common Divisor with a memory. - -sub _gcd { - my ($a, $b) = @_; - - use integer; - - # Loops forever if given negative inputs. - - if ($b and $a > $b) { return gcd($a % $b, $b) } - elsif ($a and $b > $a) { return gcd($b % $a, $a) } - else { return $a ? $a : $b } -} - -my %gcd; - -sub gcd { - my ($a, $b) = @_; - - my $id = "$a $b"; - - unless (exists $gcd{$id}) { - $gcd{$id} = _gcd($a, $b); - $gcd{"$b $a"} = $gcd{$id}; - } - - return $gcd{$id}; -} - # # ->stringify_polar # @@ -1306,74 +1380,52 @@ sub stringify_polar { my ($r, $t) = @{$z->polar}; my $theta; - return '[0,0]' if $r <= $eps; - my %format = $z->display_format; + my $format = $format{format}; - my $nt = $t / pit2; - $nt = ($nt - int($nt)) * pit2; - $nt += pit2 if $nt < 0; # Range [0, 2pi] - - if (CORE::abs($nt) <= $eps) { $theta = 0 } - elsif (CORE::abs(pi-$nt) <= $eps) { $theta = 'pi' } - - if (defined $theta) { - $r = int($r + ($r < 0 ? -1 : 1) * $eps) - if int(CORE::abs($r)) != int(CORE::abs($r) + $eps); - $theta = int($theta + ($theta < 0 ? -1 : 1) * $eps) - if ($theta ne 'pi' and - int(CORE::abs($theta)) != int(CORE::abs($theta) + $eps)); - return "\[$r,$theta\]"; + if ($t =~ /^NaN[QS]?$/i || $t =~ /^-?$Inf$/oi) { + $theta = $t; + } elsif ($t == pi) { + $theta = "pi"; + } elsif ($r == 0 || $t == 0) { + $theta = defined $format ? sprintf($format, $t) : $t; } + return "[$r,$theta]" if defined $theta; + # - # Okay, number is not a real. Try to identify pi/n and friends... + # Try to identify pi/n and friends. # - $nt -= pit2 if $nt > pi; + $t -= int(CORE::abs($t) / pit2) * pit2; - if ($format{polar_pretty_print} && CORE::abs($nt) >= deg1) { - my ($n, $k, $kpi); - - for ($k = 1, $kpi = pi; $k < 10; $k++, $kpi += pi) { - $n = int($kpi / $nt + ($nt > 0 ? 1 : -1) * 0.5); - if (CORE::abs($kpi/$n - $nt) <= $eps) { - $n = CORE::abs($n); - my $gcd = gcd($k, $n); - if ($gcd > 1) { - $k /= $gcd; - $n /= $gcd; - } - next if $n > 360; - $theta = ($nt < 0 ? '-':''). - ($k == 1 ? 'pi':"${k}pi"); - $theta .= '/'.$n if $n > 1; + if ($format{polar_pretty_print} && $t) { + my ($a, $b); + for $a (2..9) { + $b = $t * $a / pi; + if ($b =~ /^-?\d+$/) { + $b = $b < 0 ? "-" : "" if CORE::abs($b) == 1; + $theta = "${b}pi/$a"; last; } } } - $theta = $nt unless defined $theta; - - $r = int($r + ($r < 0 ? -1 : 1) * $eps) - if int(CORE::abs($r)) != int(CORE::abs($r) + $eps); - $theta = int($theta + ($theta < 0 ? -1 : 1) * $eps) - if ($theta !~ m(^-?\d*pi/\d+$) and - int(CORE::abs($theta)) != int(CORE::abs($theta) + $eps)); - - my $format = $format{format}; if (defined $format) { $r = sprintf($format, $r); - $theta = sprintf($format, $theta); + $theta = sprintf($format, $theta) unless defined $theta; + } else { + $theta = $t unless defined $theta; } - return "\[$r,$theta\]"; + return "[$r,$theta]"; } 1; __END__ =pod + =head1 NAME Math::Complex - complex numbers and associated mathematical functions @@ -1695,7 +1747,7 @@ For instance: print "j = $j\n"; # Prints "j = -0.5+0.866025403784439i" The polar style attempts to emphasize arguments like I -(where I is a positive integer and I an integer within [-9,+9]), +(where I is a positive integer and I an integer within [-9, +9]), this is called I. =head2 CHANGED IN PERL 5.6 @@ -1705,29 +1757,33 @@ C object method can now be called using a parameter hash instead of just a one parameter. The old display format style, which can have values C<"cartesian"> or -C<"polar">, can be changed using the C<"style"> parameter. (The one -parameter calling convention also still works.) +C<"polar">, can be changed using the C<"style"> parameter. + + $j->display_format(style => "polar"); + +The one parameter calling convention also still works. + + $j->display_format("polar"); There are two new display parameters. -The first one is C<"format">, which is a sprintf()-style format -string to be used for both parts of the complex number(s). The -default is C, which corresponds usually (this is somewhat -system-dependent) to C<"%.15g">. You can revert to the default by -setting the format string to C. +The first one is C<"format">, which is a sprintf()-style format string +to be used for both numeric parts of the complex number(s). The is +somewhat system-dependent but most often it corresponds to C<"%.15g">. +You can revert to the default by setting the C to C. # the $j from the above example $j->display_format('format' => '%.5f'); print "j = $j\n"; # Prints "j = -0.50000+0.86603i" - $j->display_format('format' => '%.6f'); + $j->display_format('format' => undef); print "j = $j\n"; # Prints "j = -0.5+0.86603i" Notice that this affects also the return values of the C methods: in list context the whole parameter hash -will be returned, as opposed to only the style parameter value. If -you want to know the whole truth for a complex number, you must call -both the class method and the object method: +will be returned, as opposed to only the style parameter value. +This is a potential incompatibility with earlier versions if you +have been calling the C method in list context. The second new display parameter is C<"polar_pretty_print">, which can be set to true or false, the default being true. See the previous @@ -1791,8 +1847,7 @@ is any integer. Note that because we are operating on approximations of real numbers, these errors can happen when merely `too close' to the singularities -listed above. For example C will die of -division by zero. +listed above. =head1 ERRORS DUE TO INDIGESTIBLE ARGUMENTS diff --git a/contrib/perl5/lib/Math/Trig.pm b/contrib/perl5/lib/Math/Trig.pm index 492706cd6aa8..b28f150798d2 100644 --- a/contrib/perl5/lib/Math/Trig.pm +++ b/contrib/perl5/lib/Math/Trig.pm @@ -36,14 +36,15 @@ my @rdlcnv = qw(cartesian_to_cylindrical %EXPORT_TAGS = ('radial' => [ @rdlcnv ]); -sub pi2 () { 2 * pi } # use constant generates warning -sub pip2 () { pi / 2 } # use constant generates warning -use constant DR => pi2/360; -use constant RD => 360/pi2; -use constant DG => 400/360; -use constant GD => 360/400; -use constant RG => 400/pi2; -use constant GR => pi2/400; +sub pi2 () { 2 * pi } +sub pip2 () { pi / 2 } + +sub DR () { pi2/360 } +sub RD () { 360/pi2 } +sub DG () { 400/360 } +sub GD () { 360/400 } +sub RG () { 400/pi2 } +sub GR () { pi2/400 } # # Truncating remainder. @@ -58,17 +59,23 @@ sub remt ($$) { # Angle conversions. # -sub rad2deg ($) { remt(RD * $_[0], 360) } +sub rad2rad($) { remt($_[0], pi2) } -sub deg2rad ($) { remt(DR * $_[0], pi2) } +sub deg2deg($) { remt($_[0], 360) } -sub grad2deg ($) { remt(GD * $_[0], 360) } +sub grad2grad($) { remt($_[0], 400) } -sub deg2grad ($) { remt(DG * $_[0], 400) } +sub rad2deg ($;$) { my $d = RD * $_[0]; $_[1] ? $d : deg2deg($d) } -sub rad2grad ($) { remt(RG * $_[0], 400) } +sub deg2rad ($;$) { my $d = DR * $_[0]; $_[1] ? $d : rad2rad($d) } -sub grad2rad ($) { remt(GR * $_[0], pi2) } +sub grad2deg ($;$) { my $d = GD * $_[0]; $_[1] ? $d : deg2deg($d) } + +sub deg2grad ($;$) { my $d = DG * $_[0]; $_[1] ? $d : grad2grad($d) } + +sub rad2grad ($;$) { my $d = RG * $_[0]; $_[1] ? $d : grad2grad($d) } + +sub grad2rad ($;$) { my $d = GR * $_[0]; $_[1] ? $d : rad2rad($d) } sub cartesian_to_spherical { my ( $x, $y, $z ) = @_; @@ -280,6 +287,14 @@ and the imaginary part of approximately C<-1.317>. $gradians = rad2grad($radians); The full circle is 2 I radians or I<360> degrees or I<400> gradians. +The result is by default wrapped to be inside the [0, {2pi,360,400}[ circle. +If you don't want this, supply a true second argument: + + $zillions_of_radians = deg2rad($zillions_of_degrees, 1); + $negative_degrees = rad2deg($negative_radians, 1); + +You can also do the wrapping explicitly by rad2rad(), deg2deg(), and +grad2grad(). =head1 RADIAL COORDINATE CONVERSIONS diff --git a/contrib/perl5/lib/Net/Ping.pm b/contrib/perl5/lib/Net/Ping.pm index 2713383a00c1..a2846fe90210 100644 --- a/contrib/perl5/lib/Net/Ping.pm +++ b/contrib/perl5/lib/Net/Ping.pm @@ -269,13 +269,13 @@ sub checksum ); $len_msg = length($msg); - $num_short = $len_msg / 2; + $num_short = int($len_msg / 2); $chk = 0; foreach $short (unpack("S$num_short", $msg)) { $chk += $short; } # Add the odd byte in - $chk += unpack("C", substr($msg, $len_msg - 1, 1)) if $len_msg % 2; + $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_msg % 2; $chk = ($chk >> 16) + ($chk & 0xffff); # Fold high into low return(~(($chk >> 16) + $chk) & 0xffff); # Again and complement } @@ -369,16 +369,17 @@ sub ping_udp elsif ($nfound) # A packet is waiting { $from_msg = ""; - $from_saddr = recv($self->{"fh"}, $from_msg, 1500, $flags); - ($from_port, $from_ip) = sockaddr_in($from_saddr); - if (($from_ip eq $ip) && # Does the packet check out? - ($from_port == $self->{"port_num"}) && - ($from_msg eq $msg)) - { - $ret = 1; # It's a winner - $done = 1; - } - } + $from_saddr = recv($self->{"fh"}, $from_msg, 1500, $flags) + or last; # For example an unreachable host will make recv() fail. + ($from_port, $from_ip) = sockaddr_in($from_saddr); + if (($from_ip eq $ip) && # Does the packet check out? + ($from_port == $self->{"port_num"}) && + ($from_msg eq $msg)) + { + $ret = 1; # It's a winner + $done = 1; + } + } else # Oops, timed out { $done = 1; @@ -442,7 +443,11 @@ hosts on a network. A ping object is first created with optional parameters, a variable number of hosts may be pinged multiple times and then the connection is closed. -You may choose one of three different protocols to use for the ping. +You may choose one of three different protocols to use for the +ping. The "udp" protocol is the default. Note that a live remote host +may still fail to be pingable by one or more of these protocols. For +example, www.microsoft.com is generally alive but not pingable. + With the "tcp" protocol the ping() method attempts to establish a connection to the remote host's echo port. If the connection is successfully established, the remote host is considered reachable. No @@ -455,6 +460,11 @@ received from the remote host and the received packet contains the same data as the packet that was sent, the remote host is considered reachable. This protocol does not require any special privileges. +It should be borne in mind that, for both tcp and udp ping, a host +will be reported as unreachable if it is not running the +appropriate echo service. For Unix-like systems see L for +more information. + If the "icmp" protocol is specified, the ping() method sends an icmp echo message to the remote host, which is what the UNIX ping program does. If the echoed message is received from the remote host and diff --git a/contrib/perl5/lib/Net/protoent.pm b/contrib/perl5/lib/Net/protoent.pm index 334af789149a..00a76aff075c 100644 --- a/contrib/perl5/lib/Net/protoent.pm +++ b/contrib/perl5/lib/Net/protoent.pm @@ -6,7 +6,7 @@ our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS); BEGIN { use Exporter (); @EXPORT = qw(getprotobyname getprotobynumber getprotoent); - @EXPORT_OK = qw( $p_name @p_aliases $p_proto ); + @EXPORT_OK = qw( $p_name @p_aliases $p_proto getproto ); %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); } use vars @EXPORT_OK; @@ -78,6 +78,7 @@ regular array variables, so for example C<@{ $proto_obj-Ealiases() The getproto() function is a simple front-end that forwards a numeric argument to getprotobyport(), and the rest to getprotobyname(). +This function is not exported by default. To access this functionality without the core overrides, pass the C an empty import list, and then access diff --git a/contrib/perl5/lib/Pod/Checker.pm b/contrib/perl5/lib/Pod/Checker.pm index ae32677db1a3..0863c80fc888 100644 --- a/contrib/perl5/lib/Pod/Checker.pm +++ b/contrib/perl5/lib/Pod/Checker.pm @@ -10,7 +10,7 @@ package Pod::Checker; use vars qw($VERSION); -$VERSION = 1.098; ## Current version of this package +$VERSION = 1.2; ## Current version of this package require 5.005; ## requires this Perl version or later use Pod::ParseUtils; ## for hyperlinks and lists @@ -44,7 +44,8 @@ This function can take a hash of options: =item B<-warnings> =E I -Turn warnings on/off. See L<"Warnings">. +Turn warnings on/off. I is usually 1 for on, but higher values +trigger additional warnings. See L<"Warnings">. =back @@ -212,15 +213,14 @@ There is some whitespace on a seemingly empty line. POD is very sensitive to such things, so this is flagged. B users switch on the B option to avoid this problem. +=begin _disabled_ + =item * file does not start with =head The file starts with a different POD directive than head. This is most probably something you do not want. -=item * No numeric argument for =over - -The C<=over> command is supposed to have a numeric argument (the -indentation). +=end _disabled_ =item * previous =item has no contents @@ -243,7 +243,8 @@ type of the I C<=item> determines the type of the list. Angle brackets not written as CltE> and CgtE> can potentially cause errors as they could be misinterpreted as -markup commands. +markup commands. This is only printed when the -warnings level is +greater than 1. =item * Unknown entity @@ -273,11 +274,36 @@ The NAME section (C<=head1 NAME>) should consist of a single paragraph with the script/module name, followed by a dash `-' and a very short description of what the thing is good for. -=item * Hyperlinks +=back -There are some warnings wrt. hyperlinks: -Leading/trailing whitespace, newlines in hyperlinks, -brackets C<()>. +=head2 Hyperlinks + +There are some warnings wrt. malformed hyperlinks. + +=over 4 + +=item * ignoring leading/trailing whitespace in link + +There is whitespace at the beginning or the end of the contents of +LE...E. + +=item * (section) in '$page' deprecated + +There is a section detected in the page name of LE...E, e.g. +Cpasswd(2)E>. POD hyperlinks may point to POD documents only. +Please write Cpasswd(2)E> instead. Some formatters are able +to expand this to appropriate code. For links to (builtin) functions, +please say Cperlfunc/mkdirE>, without (). + +=item * alternative text/node '%s' contains non-escaped | or / + +The characters C<|> and C are special in the LE...E context. +Although the hyperlink parser does its best to determine which "/" is +text and which is a delimiter in case of doubt, one ought to escape +these literal characters like this: + + / E + | E =back @@ -307,7 +333,6 @@ use strict; use Carp; use Exporter; use Pod::Parser; -require VMS::Filespec if $^O eq 'VMS'; use vars qw(@ISA @EXPORT); @ISA = qw(Pod::Parser); @@ -471,7 +496,6 @@ sub podchecker( $ ; $ % ) { ## Now create a pod checker my $checker = new Pod::Checker(%options); - $checker->parseopts(-process_cut_cmd => 1, -warnings => 1); ## Now check the pod document for errors $checker->parse_from_file($infile, $outfile); @@ -486,6 +510,27 @@ sub podchecker( $ ; $ % ) { ## Method definitions begin here ##------------------------------- +################################## + +=over 4 + +=item Cnew( %options )> + +Return a reference to a new Pod::Checker object that inherits from +Pod::Parser and is used for calling the required methods later. The +following options are recognized: + +C<-warnings =E num> + Print warnings if C is true. The higher the value of C, +the more warnings are printed. Currently there are only levels 1 and 2. + +C<-quiet =E num> + If C is true, do not print any errors/warnings. This is useful +when Pod::Checker is used to munge POD code into plain text from within +POD formatters. + +=cut + ## sub new { ## my $this = shift; ## my $class = ref($this) || $this; @@ -501,7 +546,9 @@ sub initialize { ## Initialize number of errors, and setup an error function to ## increment this number and then print to the designated output. $self->{_NUM_ERRORS} = 0; - $self->errorsub('poderror'); # set the error handling subroutine + $self->{-quiet} ||= 0; + # set the error handling subroutine + $self->errorsub($self->{-quiet} ? sub { 1; } : 'poderror'); $self->{_commands} = 0; # total number of POD commands encountered $self->{_list_stack} = []; # stack for nested lists $self->{_have_begin} = ''; # stores =begin @@ -511,12 +558,11 @@ sub initialize { # print warnings? $self->{-warnings} = 1 unless(defined $self->{-warnings}); $self->{_current_head1} = ''; # the current =head1 block + $self->parseopts(-process_cut_cmd => 1, -warnings => $self->{-warnings}); } ################################## -=over 4 - =item C<$checker-Epoderror( @args )> =item C<$checker-Epoderror( {%opts}, @args )> @@ -547,7 +593,6 @@ The error level, should be 'WARNING' or 'ERROR'. sub poderror { my $self = shift; my %opts = (ref $_[0]) ? %{shift()} : (); - $opts{-file} = VMS::Filespec::unixify($opts{-file}) if (exists($opts{-file}) && $^O eq 'VMS'); ## Retrieve options chomp( my $msg = ($opts{-msg} || "")."@_" ); @@ -562,7 +607,7 @@ sub poderror { ## Increment error count and print message " ++($self->{_NUM_ERRORS}) if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR')); - my $out_fh = $self->output_handle(); + my $out_fh = $self->output_handle() || \*STDERR; print $out_fh ($severity, $msg, $line, $file, "\n") if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING'); } @@ -672,7 +717,6 @@ sub end_pod { ## print the number of errors found my $self = shift; my $infile = $self->input_file(); - $infile = VMS::Filespec::unixify($infile) if $^O eq 'VMS'; my $out_fh = $self->output_handle(); if(@{$self->{_list_stack}}) { @@ -691,12 +735,15 @@ sub end_pod { my %nodes; foreach($self->node()) { $nodes{$_} = 1; - if(/^(\S+)\s+/) { + if(/^(\S+)\s+\S/) { # we have more than one word. Use the first as a node, too. # This is used heavily in perlfunc.pod $nodes{$1} ||= 2; # derived node } } + foreach($self->idx()) { + $nodes{$_} = 3; # index node + } foreach($self->hyperlink()) { my ($line,$link) = @$_; # _TODO_ what if there is a link to the page itself by the name, @@ -746,24 +793,23 @@ sub command { $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', -msg => "Unknown command '$cmd'" }); } - else { - # found a valid command - if(!$self->{_commands}++ && $cmd !~ /^head/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "file does not start with =head" }); - } - ## check syntax of particular command + else { # found a valid command + $self->{_commands}++; # delete this line if below is enabled again + + ##### following check disabled due to strong request + #if(!$self->{_commands}++ && $cmd !~ /^head/) { + # $self->poderror({ -line => $line, -file => $file, + # -severity => 'WARNING', + # -msg => "file does not start with =head" }); + #} + + # check syntax of particular command if($cmd eq 'over') { # check for argument $arg = $self->interpolate_and_check($paragraph, $line,$file); my $indent = 4; # default if($arg && $arg =~ /^\s*(\d+)\s*$/) { $indent = $1; - } else { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "No numeric argument for =over"}); } # start a new list $self->_open_list($indent,$line,$file); @@ -1005,12 +1051,13 @@ sub _check_ptree { unless(ref) { my $count; # count the unescaped angle brackets + # complain only when warning level is greater than 1 my $i = $_; if($count = $i =~ tr/<>/<>/) { $self->poderror({ -line => $line, -file => $file, -severity => 'WARNING', -msg => "$count unescaped <> in paragraph" }) - if($self->{-warnings}); + if($self->{-warnings} && $self->{-warnings}>1); } $text .= $i; next; diff --git a/contrib/perl5/lib/Pod/Find.pm b/contrib/perl5/lib/Pod/Find.pm index 8de197b71da4..4a0ecb9e65a9 100644 --- a/contrib/perl5/lib/Pod/Find.pm +++ b/contrib/perl5/lib/Pod/Find.pm @@ -13,8 +13,9 @@ package Pod::Find; use vars qw($VERSION); -$VERSION = 0.12; ## Current version of this package -require 5.005; ## requires this Perl version or later +$VERSION = 0.21; ## Current version of this package +require 5.005; ## requires this Perl version or later +use Carp; ############################################################################# @@ -32,12 +33,38 @@ Pod::Find - find POD documents in directory trees print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n"; + $location = pod_where( { -inc => 1 }, "Pod::Find" ); + =head1 DESCRIPTION -B provides a function B that searches for POD -documents in a given set of files and directories. It returns a hash -with the file names as keys and the POD name as value. The POD name -is derived from the file name and its position in the directory tree. +B provides a set of functions to locate POD files. Note that +no function is exported by default to avoid pollution of your namespace, +so be sure to specify them in the B statement if you need them: + + use Pod::Find qw(pod_find); + +=cut + +use strict; +#use diagnostics; +use Exporter; +use File::Spec; +use File::Find; +use Cwd; + +use vars qw(@ISA @EXPORT_OK $VERSION); +@ISA = qw(Exporter); +@EXPORT_OK = qw(&pod_find &simplify_name &pod_where &contains_pod); + +# package global variables +my $SIMPLIFY_RX; + +=head2 C + +The function B searches for POD documents in a given set of +files and/or directories. It returns a hash with the file names as keys +and the POD name as value. The POD name is derived from the file name +and its position in the directory tree. E.g. when searching in F<$HOME/perl5lib>, the file F<$HOME/perl5lib/MyModule.pm> would get the POD name I, @@ -51,73 +78,39 @@ A warning is printed if more than one POD file with the same POD name is found, e.g. F in different directories. This usually indicates duplicate occurrences of modules in the I<@INC> search path. -The function B is equivalent to B, but also -strips Perl-like extensions (.pm, .pl, .pod) and extensions like -F<.bat>, F<.cmd> on Win32 and OS/2, respectively. - -Note that neither B nor B are exported by -default so be sure to specify them in the B statement if you need -them: - - use Pod::Find qw(pod_find simplify_name); - -=head1 OPTIONS - -The first argument for B may be a hash reference with options. -The rest are either directories that are searched recursively or files. -The POD names of files are the plain basenames with any Perl-like extension -(.pm, .pl, .pod) stripped. +B The first argument for B may be a hash reference +with options. The rest are either directories that are searched +recursively or files. The POD names of files are the plain basenames +with any Perl-like extension (.pm, .pl, .pod) stripped. =over 4 -=item B<-verbose> +=item C<-verbose =E 1> Print progress information while scanning. -=item B<-perl> +=item C<-perl =E 1> Apply Perl-specific heuristics to find the correct PODs. This includes stripping Perl-like extensions, omitting subdirectories that are numeric but do I match the current Perl interpreter's version id, suppressing F as a module hierarchy name etc. -=item B<-script> +=item C<-script =E 1> Search for PODs in the current Perl interpreter's installation B. This is taken from the local L module. -=item B<-inc> +=item C<-inc =E 1> Search for PODs in the current Perl interpreter's I<@INC> paths. This -automatically considers paths specified in the C environment. +automatically considers paths specified in the C environment +as this is prepended to I<@INC> by the Perl interpreter itself. =back -=head1 AUTHOR - -Marek Rouchal Emarek@saftsack.fs.uni-bayreuth.deE, -heavily borrowing code from Nick Ing-Simmons' PodToHtml. - -=head1 SEE ALSO - -L, L - =cut -use strict; -#use diagnostics; -use Exporter; -use File::Spec; -use File::Find; -use Cwd; - -use vars qw(@ISA @EXPORT_OK $VERSION); -@ISA = qw(Exporter); -@EXPORT_OK = qw(&pod_find &simplify_name); - -# package global variables -my $SIMPLIFY_RX; - # return a hash of the POD files found # first argument may be a hashref (options), # rest is a list of directories to search recursively @@ -152,7 +145,7 @@ sub pod_find # * remove e.g. 5.00503 # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod) $SIMPLIFY_RX = - qq!^(?i:site_perl/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!; + qq!^(?i:site(_perl)?/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!; } @@ -167,7 +160,9 @@ sub pod_find $try = File::Spec->catfile($pwd,$try); } # simplify path - $try = File::Spec->canonpath($try); + # on VMS canonpath will vmsify:[the.path], but File::Find::find + # wants /unixy/paths + $try = File::Spec->canonpath($try) if ($^O ne 'VMS'); my $name; if(-f $try) { if($name = _check_and_extract_name($try, $opts{-verbose})) { @@ -222,27 +217,14 @@ sub _check_and_extract_name { # check extension or executable flag # this involves testing the .bat extension on Win32! - unless($file =~ /\.(pod|pm|plx?)\z/i || (-f $file && -x _ && -T _)) { - return undef; + unless(-f $file && -T _ && ($file =~ /\.(pod|pm|plx?)\z/i || -x _ )) { + return undef; } - # check for one line of POD - unless(open(POD,"<$file")) { - warn "Error: $file is unreadable: $!\n"; - return undef; - } - local $/ = undef; - my $pod = ; - close(POD); - unless($pod =~ /\n=(head\d|pod|over|item)\b/) { - warn "No POD in $file, skipping.\n" - if($verbose); - return; - } - undef $pod; + return undef unless contains_pod($file,$verbose); # strip non-significant path components - # _TODO_ what happens on e.g. Win32? + # TODO what happens on e.g. Win32? my $name = $file; if(defined $root_rx) { $name =~ s!$root_rx!!s; @@ -256,6 +238,14 @@ sub _check_and_extract_name { $name; } +=head2 C + +The function B is equivalent to B, but also +strips Perl-like extensions (.pm, .pl, .pod) and extensions like +F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively. + +=cut + # basic simplification of the POD name: # basename & strip extension sub simplify_name { @@ -271,8 +261,185 @@ sub _simplify { # strip Perl's own extensions $_[0] =~ s/\.(pod|pm|plx?)\z//i; # strip meaningless extensions on Win32 and OS/2 - $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /win|os2/i); + $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /mswin|os2/i); + # strip meaningless extensions on VMS + $_[0] =~ s/\.(com)\z//i if($^O eq 'VMS'); } +# contribution from Tim Jenness + +=head2 C + +Returns the location of a pod document given a search directory +and a module (e.g. C) or script (e.g. C) name. + +Options: + +=over 4 + +=item C<-inc =E 1> + +Search @INC for the pod and also the C defined in the +L module. + +=item C<-dirs =E [ $dir1, $dir2, ... ]> + +Reference to an array of search directories. These are searched in order +before looking in C<@INC> (if B<-inc>). Current directory is used if +none are specified. + +=item C<-verbose =E 1> + +List directories as they are searched + +=back + +Returns the full path of the first occurence to the file. +Package names (eg 'A::B') are automatically converted to directory +names in the selected directory. (eg on unix 'A::B' is converted to +'A/B'). Additionally, '.pm', '.pl' and '.pod' are appended to the +search automatically if required. + +A subdirectory F is also checked if it exists in any of the given +search directories. This ensures that e.g. L is +found. + +It is assumed that if a module name is supplied, that that name +matches the file name. Pods are not opened to check for the 'NAME' +entry. + +A check is made to make sure that the file that is found does +contain some pod documentation. + +=cut + +sub pod_where { + + # default options + my %options = ( + '-inc' => 0, + '-verbose' => 0, + '-dirs' => [ '.' ], + ); + + # Check for an options hash as first argument + if (defined $_[0] && ref($_[0]) eq 'HASH') { + my $opt = shift; + + # Merge default options with supplied options + %options = (%options, %$opt); + } + + # Check usage + carp 'Usage: pod_where({options}, $pod)' unless (scalar(@_)); + + # Read argument + my $pod = shift; + + # Split on :: and then join the name together using File::Spec + my @parts = split (/::/, $pod); + + # Get full directory list + my @search_dirs = @{ $options{'-dirs'} }; + + if ($options{'-inc'}) { + + require Config; + + # Add @INC + push (@search_dirs, @INC) if $options{'-inc'}; + + # Add location of pod documentation for perl man pages (eg perlfunc) + # This is a pod directory in the private install tree + #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'}, + # 'pod'); + #push (@search_dirs, $perlpoddir) + # if -d $perlpoddir; + + # Add location of binaries such as pod2text + push (@search_dirs, $Config::Config{'scriptdir'}) + if -d $Config::Config{'scriptdir'}; + } + + # Loop over directories + Dir: foreach my $dir ( @search_dirs ) { + + # Don't bother if cant find the directory + if (-d $dir) { + warn "Looking in directory $dir\n" + if $options{'-verbose'}; + + # Now concatenate this directory with the pod we are searching for + my $fullname = File::Spec->catfile($dir, @parts); + warn "Filename is now $fullname\n" + if $options{'-verbose'}; + + # Loop over possible extensions + foreach my $ext ('', '.pod', '.pm', '.pl') { + my $fullext = $fullname . $ext; + if (-f $fullext && + contains_pod($fullext, $options{'-verbose'}) ) { + warn "FOUND: $fullext\n" if $options{'-verbose'}; + return $fullext; + } + } + } else { + warn "Directory $dir does not exist\n" + if $options{'-verbose'}; + next Dir; + } + if(-d File::Spec->catdir($dir,'pod')) { + $dir = File::Spec->catdir($dir,'pod'); + redo Dir; + } + } + # No match; + return undef; +} + +=head2 C + +Returns true if the supplied filename (not POD module) contains some pod +information. + +=cut + +sub contains_pod { + my $file = shift; + my $verbose = 0; + $verbose = shift if @_; + + # check for one line of POD + unless(open(POD,"<$file")) { + warn "Error: $file is unreadable: $!\n"; + return undef; + } + + local $/ = undef; + my $pod = ; + close(POD) || die "Error closing $file: $!\n"; + unless($pod =~ /\n=(head\d|pod|over|item)\b/s) { + warn "No POD in $file, skipping.\n" + if($verbose); + return 0; + } + + return 1; +} + +=head1 AUTHOR + +Marek Rouchal Emarek@saftsack.fs.uni-bayreuth.deE, +heavily borrowing code from Nick Ing-Simmons' PodToHtml. + +Tim Jenness Et.jenness@jach.hawaii.eduE provided +C and C. + +=head1 SEE ALSO + +L, L, L + +=cut + 1; diff --git a/contrib/perl5/lib/Pod/Functions.pm b/contrib/perl5/lib/Pod/Functions.pm index 03cbf711eb6d..44619d53d8bb 100644 --- a/contrib/perl5/lib/Pod/Functions.pm +++ b/contrib/perl5/lib/Pod/Functions.pm @@ -296,7 +296,7 @@ values HASH return a list of the values in a hash vec Binary test or set particular bits in a string wait Process wait for any child process to die waitpid Process wait for a particular child process to die -wantarray Misc,Flow get list vs array context of current subroutine call +wantarray Misc,Flow get void vs scalar vs list context of current subroutine call warn I/O print debugging info write I/O print a picture record y/// String transliterate a string diff --git a/contrib/perl5/lib/Pod/Html.pm b/contrib/perl5/lib/Pod/Html.pm index 89e3d0f43259..f70a42bccce9 100644 --- a/contrib/perl5/lib/Pod/Html.pm +++ b/contrib/perl5/lib/Pod/Html.pm @@ -893,6 +893,10 @@ sub scan_dir { $pages{$_} = "" unless defined $pages{$_}; $pages{$_} .= "$dir/$_.pod:"; push(@pods, "$dir/$_.pod"); + } elsif (/\.html\z/) { # .html + s/\.html\z//; + $pages{$_} = "" unless defined $pages{$_}; + $pages{$_} .= "$dir/$_.pod:"; } elsif (/\.pm\z/) { # .pm s/\.pm\z//; $pages{$_} = "" unless defined $pages{$_}; @@ -1438,8 +1442,10 @@ sub process_text1($$;$$){ } elsif( $func eq 'E' ){ # E - convert to character - $$rstr =~ s/^(\w+)>//; - $res = "&$1;"; + $$rstr =~ s/^([^>]*)>//; + my $escape = $1; + $escape =~ s/^(\d+|X[\dA-F]+)$/#$1/i; + $res = "&$escape;"; } elsif( $func eq 'F' ){ # F - italizice @@ -1940,7 +1946,7 @@ sub depod1($;$$){ $res .= $$rstr; } elsif( $func eq 'E' ){ # E - convert to character - $$rstr =~ s/^(\w+)>//; + $$rstr =~ s/^([^>]*)>//; $res .= $E2c{$1} || ""; } elsif( $func eq 'X' ){ # X<> - ignore diff --git a/contrib/perl5/lib/Pod/InputObjects.pm b/contrib/perl5/lib/Pod/InputObjects.pm index 849182bf3717..352373b9da40 100644 --- a/contrib/perl5/lib/Pod/InputObjects.pm +++ b/contrib/perl5/lib/Pod/InputObjects.pm @@ -11,7 +11,7 @@ package Pod::InputObjects; use vars qw($VERSION); -$VERSION = 1.12; ## Current version of this package +$VERSION = 1.13; ## Current version of this package require 5.005; ## requires this Perl version or later ############################################################################# @@ -42,7 +42,7 @@ are defined: =begin __PRIVATE__ -=item B +=item package B An object corresponding to a source of POD input text. It is mostly a wrapper around a filehandle or C-type object (or anything @@ -51,23 +51,23 @@ additional information relevant to the parsing of PODs. =end __PRIVATE__ -=item B +=item package B An object corresponding to a paragraph of POD input text. It may be a plain paragraph, a verbatim paragraph, or a command paragraph (see L). -=item B +=item package B An object corresponding to an interior sequence command from the POD input text (see L). -=item B +=item package B An object corresponding to a tree of parsed POD text. Each "node" in a parse-tree (or I) is either a text-string or a reference to a B object. The nodes appear in the parse-tree -in they order in which they were parsed from left-to-right. +in the order in which they were parsed from left-to-right. =back @@ -232,7 +232,7 @@ It has the following methods/attributes: ##--------------------------------------------------------------------------- -=head2 B +=head2 Pod::Paragraph-EB my $pod_para1 = Pod::Paragraph->new(-text => $text); my $pod_para2 = Pod::Paragraph->new(-name => $cmd, @@ -284,7 +284,7 @@ sub new { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_para-EB my $para_cmd = $pod_para->cmd_name(); @@ -303,7 +303,7 @@ sub cmd_name { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_para-EB my $para_text = $pod_para->text(); @@ -318,7 +318,7 @@ sub text { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_para-EB my $raw_pod_para = $pod_para->raw_text(); @@ -335,7 +335,7 @@ sub raw_text { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_para-EB my $prefix = $pod_para->cmd_prefix(); @@ -351,7 +351,7 @@ sub cmd_prefix { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_para-EB my $separator = $pod_para->cmd_separator(); @@ -367,7 +367,7 @@ sub cmd_separator { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_para-EB my $ptree = $pod_parser->parse_text( $pod_para->text() ); $pod_para->parse_tree( $ptree ); @@ -387,13 +387,13 @@ sub parse_tree { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_para-EB my ($filename, $line_number) = $pod_para->file_line(); my $position = $pod_para->file_line(); Returns the current filename and line number for the paragraph -object. If called in an array context, it returns a list of two +object. If called in a list context, it returns a list of two elements: first the filename, then the line number. If called in a scalar context, it returns a string containing the filename, followed by a colon (':'), followed by the line number. @@ -423,7 +423,7 @@ It has the following methods/attributes: ##--------------------------------------------------------------------------- -=head2 B +=head2 Pod::InteriorSequence-EB my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd -ldelim => $delimiter); @@ -497,7 +497,7 @@ sub new { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_seq-EB my $seq_cmd = $pod_seq->cmd_name(); @@ -546,7 +546,7 @@ sub _unset_child2parent_links { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_seq-EB $pod_seq->prepend($text); $pod_seq1->prepend($pod_seq2); @@ -565,7 +565,7 @@ sub prepend { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_seq-EB $pod_seq->append($text); $pod_seq1->append($pod_seq2); @@ -584,7 +584,7 @@ sub append { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_seq-EB $outer_seq = $pod_seq->nested || print "not nested"; @@ -602,7 +602,7 @@ sub nested { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_seq-EB my $seq_raw_text = $pod_seq->raw_text(); @@ -623,7 +623,7 @@ sub raw_text { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_seq-EB my $ldelim = $pod_seq->left_delimiter(); @@ -642,7 +642,7 @@ sub left_delimiter { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_seq-EB The rightmost delimiter beginning the argument text to the interior sequence (should be ">"). @@ -659,7 +659,7 @@ sub right_delimiter { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_seq-EB my $ptree = $pod_parser->parse_text($paragraph_text); $pod_seq->parse_tree( $ptree ); @@ -680,13 +680,13 @@ sub parse_tree { ##--------------------------------------------------------------------------- -=head2 B +=head2 $pod_seq-EB my ($filename, $line_number) = $pod_seq->file_line(); my $position = $pod_seq->file_line(); Returns the current filename and line number for the interior sequence -object. If called in an array context, it returns a list of two +object. If called in a list context, it returns a list of two elements: first the filename, then the line number. If called in a scalar context, it returns a string containing the filename, followed by a colon (':'), followed by the line number. @@ -701,7 +701,7 @@ sub file_line { ##--------------------------------------------------------------------------- -=head2 B +=head2 Pod::InteriorSequence::B This method performs any necessary cleanup for the interior-sequence. If you override this method then it is B that you invoke @@ -738,7 +738,7 @@ itself contain a parse-tree (since interior sequences may be nested). ##--------------------------------------------------------------------------- -=head2 B +=head2 Pod::ParseTree-EB my $ptree1 = Pod::ParseTree->new; my $ptree2 = new Pod::ParseTree; @@ -766,7 +766,7 @@ sub new { ##--------------------------------------------------------------------------- -=head2 B +=head2 $ptree-EB my $top_node = $ptree->top(); $ptree->top( $top_node ); @@ -794,7 +794,7 @@ sub top { ##--------------------------------------------------------------------------- -=head2 B +=head2 $ptree-EB This method gets/sets the children of the top node in the parse-tree. If no arguments are given, it returns the list (array) of children @@ -814,7 +814,7 @@ sub children { ##--------------------------------------------------------------------------- -=head2 B +=head2 $ptree-EB This method prepends the given text or parse-tree to the current parse-tree. If the first item on the parse-tree is text and the argument is also text, @@ -842,7 +842,7 @@ sub prepend { ##--------------------------------------------------------------------------- -=head2 B +=head2 $ptree-EB This method appends the given text or parse-tree to the current parse-tree. If the last item on the parse-tree is text and the argument is also text, @@ -866,7 +866,7 @@ sub append { } } -=head2 B +=head2 $ptree-EB my $ptree_raw_text = $ptree->raw_text(); @@ -902,7 +902,7 @@ sub _set_child2parent_links { ## nothing to do, Pod::ParseTrees cant have parent pointers } -=head2 B +=head2 Pod::ParseTree::B This method performs any necessary cleanup for the parse-tree. If you override this method then it is B diff --git a/contrib/perl5/lib/Pod/Man.pm b/contrib/perl5/lib/Pod/Man.pm index 97a382823e6f..31036826b955 100644 --- a/contrib/perl5/lib/Pod/Man.pm +++ b/contrib/perl5/lib/Pod/Man.pm @@ -1,7 +1,7 @@ # Pod::Man -- Convert POD data to formatted *roff input. -# $Id: Man.pm,v 1.2 2000/03/19 07:30:13 eagle Exp $ +# $Id: Man.pm,v 1.15 2001/02/10 06:50:22 eagle Exp $ # -# Copyright 1999, 2000 by Russ Allbery +# Copyright 1999, 2000, 2001 by Russ Allbery # # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. @@ -38,7 +38,7 @@ use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION); # Perl core and too many things could munge CVS magic revision strings. # This number should ideally be the same as the CVS revision in podlators, # however. -$VERSION = 1.02; +$VERSION = 1.15; ############################################################################ @@ -47,8 +47,10 @@ $VERSION = 1.02; # The following is the static preamble which starts all *roff output we # generate. It's completely static except for the font to use as a -# fixed-width font, which is designed by @CFONT@. $PREAMBLE should -# therefore be run through s/\@CFONT\@//g before output. +# fixed-width font, which is designed by @CFONT@, and the left and right +# quotes to use for C<> text, designated by @LQOUTE@ and @RQUOTE@. +# $PREAMBLE should therefore be run through s/\@CFONT\@//g before +# output. $PREAMBLE = <<'----END OF PREAMBLE----'; .de Sh \" Subsection heading .br @@ -93,8 +95,8 @@ $PREAMBLE = <<'----END OF PREAMBLE----'; . if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch . ds L" "" . ds R" "" -. ds C` ` -. ds C' ' +. ds C` @LQUOTE@ +. ds C' @RQUOTE@ 'br\} .el\{\ . ds -- \|\(em\| @@ -110,7 +112,7 @@ $PREAMBLE = <<'----END OF PREAMBLE----'; .if \nF \{\ . de IX . tm Index:\\$1\t\\n%\t"\\$2" -. . +.. . nr % 0 . rr F .\} @@ -183,7 +185,8 @@ $PREAMBLE = <<'----END OF PREAMBLE----'; .\} .rm #[ #] #H #V #F C ----END OF PREAMBLE---- - +#`# for cperl-mode + # This table is taken nearly verbatim from Tom Christiansen's pod2man. It # assumes that the standard preamble has already been printed, since that's # what defines all of the accent marks. Note that some of these are quoted @@ -194,6 +197,8 @@ $PREAMBLE = <<'----END OF PREAMBLE----'; 'lt' => '<', # left chevron, less-than 'gt' => '>', # right chevron, greater-than 'quot' => '"', # double quote + 'sol' => '/', # solidus (forward slash) + 'verbar' => '|', # vertical bar 'Aacute' => "A\\*'", # capital A, acute accent 'aacute' => "a\\*'", # small a, acute accent @@ -273,38 +278,11 @@ sub protect { s/^([.\'\\])/\\&$1/mg; $_; } - -# Given a command and a single argument that may or may not contain double -# quotes, handle double-quote formatting for it. If there are no double -# quotes, just return the command followed by the argument in double quotes. -# If there are double quotes, use an if statement to test for nroff, and for -# nroff output the command followed by the argument in double quotes with -# embedded double quotes doubled. For other formatters, remap paired double -# quotes to `` and ''. -sub switchquotes { - my $command = shift; - local $_ = shift; - my $extra = shift; - s/\\\*\([LR]\"/\"/g; - if (/\"/) { - s/\"/\"\"/g; - my $troff = $_; - $troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g; - s/\"/\"\"/g if $extra; - $troff =~ s/\"/\"\"/g if $extra; - $_ = qq("$_") . ($extra ? " $extra" : ''); - $troff = qq("$troff") . ($extra ? " $extra" : ''); - return ".if n $command $_\n.el $command $troff\n"; - } else { - $_ = qq("$_") . ($extra ? " $extra" : ''); - return "$command $_\n"; - } -} # Translate a font string into an escape. sub toescape { (length ($_[0]) > 1 ? '\f(' : '\f') . $_[0] } - + ############################################################################ # Initialization ############################################################################ @@ -323,7 +301,8 @@ sub initialize { for (qw/fixed fixedbold fixeditalic fixedbolditalic/) { if (defined $$self{$_}) { if (length ($$self{$_}) < 1 || length ($$self{$_}) > 2) { - croak "roff font should be 1 or 2 chars, not `$$self{$_}'"; + croak qq(roff font should be 1 or 2 chars,) + . qq( not "$$self{$_}"); } } else { $$self{$_} = ''; @@ -368,16 +347,35 @@ sub initialize { $$self{$_} =~ s/\"/\"\"/g if $$self{$_}; } + # Figure out what quotes we'll be using for C<> text. + $$self{quotes} ||= '"'; + if ($$self{quotes} eq 'none') { + $$self{LQUOTE} = $$self{RQUOTE} = ''; + } elsif (length ($$self{quotes}) == 1) { + $$self{LQUOTE} = $$self{RQUOTE} = $$self{quotes}; + } elsif ($$self{quotes} =~ /^(.)(.)$/ + || $$self{quotes} =~ /^(..)(..)$/) { + $$self{LQUOTE} = $1; + $$self{RQUOTE} = $2; + } else { + croak qq(Invalid quote specification "$$self{quotes}"); + } + + # Double the first quote; note that this should not be s///g as two + # double quotes is represented in *roff as three double quotes, not + # four. Weird, I know. + $$self{LQUOTE} =~ s/\"/\"\"/; + $$self{RQUOTE} =~ s/\"/\"\"/; + $$self{INDENT} = 0; # Current indentation level. $$self{INDENTS} = []; # Stack of indentations. $$self{INDEX} = []; # Index keys waiting to be printed. + $$self{ITEMS} = 0; # The number of consecutive =items. $self->SUPER::initialize; } -# For each document we process, output the preamble first. Note that the -# fixed width font is a global default; once we interpolate it into the -# PREAMBLE, it ain't ever changing. Maybe fix this later. +# For each document we process, output the preamble first. sub begin_pod { my $self = shift; @@ -412,6 +410,10 @@ sub begin_pod { } } + # If $name contains spaces, quote it; this mostly comes up in the case + # of input from stdin. + $name = '"' . $name . '"' if ($name =~ /\s/); + # Modification date header. Try to use the modification time of our # input. if (!defined $$self{date}) { @@ -423,15 +425,18 @@ sub begin_pod { } # Now, print out the preamble and the title. - $PREAMBLE =~ s/\@CFONT\@/$$self{fixed}/; - chomp $PREAMBLE; + local $_ = $PREAMBLE; + s/\@CFONT\@/$$self{fixed}/; + s/\@LQUOTE\@/$$self{LQUOTE}/; + s/\@RQUOTE\@/$$self{RQUOTE}/; + chomp $_; print { $self->output_handle } <<"----END OF HEADER----"; .\\" Automatically generated by Pod::Man version $VERSION .\\" @{[ scalar localtime ]} .\\" .\\" Standard preamble: .\\" ====================================================================== -$PREAMBLE +$_ .\\" ====================================================================== .\\" .IX Title "$name $section" @@ -458,9 +463,19 @@ sub command { my $self = shift; my $command = shift; return if $command eq 'pod'; - return if ($$self{EXCLUDE} && $command ne 'end'); - $command = 'cmd_' . $command; - $self->$command (@_); + return if ($$self{EXCLUDE} && $command ne 'end'); + if ($self->can ('cmd_' . $command)) { + $command = 'cmd_' . $command; + $self->$command (@_); + } else { + my ($text, $line, $paragraph) = @_; + my $file; + ($file, $line) = $paragraph->file_line; + $text =~ s/\n+\z//; + $text = " $text" if ($text =~ /^\S/); + warn qq($file:$line: Unknown command paragraph "=$command$text"\n); + return; + } } # Called for a verbatim paragraph. Gets the paragraph, the line number, and @@ -477,7 +492,7 @@ sub verbatim { 1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me; s/\\/\\e/g; s/^(\s*\S)/'\&' . $1/gme; - $self->makespace if $$self{NEEDSPACE}; + $self->makespace; $self->output (".Vb $lines\n$_.Ve\n"); $$self{NEEDSPACE} = 0; } @@ -503,7 +518,7 @@ sub textblock { > ( ,?\s+(and\s+)? # Allow lots of them, conjuncted. - L< + L< / ( [:\w]+ ( \(\) )? ) > @@ -529,8 +544,8 @@ sub textblock { # scalars as well as scalars and does the right thing with them. $text = $self->parse ($text, @_); $text =~ s/\n\s*$/\n/; - $self->makespace if $$self{NEEDSPACE}; - $self->output (protect $self->mapfonts ($text)); + $self->makespace; + $self->output (protect $self->textmapfonts ($text)); $self->outindex; $$self{NEEDSPACE} = 1; } @@ -550,8 +565,11 @@ sub sequence { return bless \ "$tmp", 'Pod::Man::String'; } - # C<>, L<>, X<>, and E<> don't apply guesswork to their contents. - local $_ = $self->collapse ($seq->parse_tree, $command =~ /^[CELX]$/); + # C<>, L<>, X<>, and E<> don't apply guesswork to their contents. C<> + # needs some additional special handling. + my $literal = ($command =~ /^[CELX]$/); + $literal++ if $command eq 'C'; + local $_ = $self->collapse ($seq->parse_tree, $literal); # Handle E<> escapes. if ($command eq 'E') { @@ -576,8 +594,6 @@ sub sequence { } elsif ($command eq 'I') { return bless \ ('\f(IS' . $_ . '\f(IE'), 'Pod::Man::String'; } elsif ($command eq 'C') { - s/-/\\-/g; - s/__/_\\|_/g; return bless \ ('\f(FS\*(C`' . $_ . "\\*(C'\\f(FE"), 'Pod::Man::String'; } @@ -588,7 +604,7 @@ sub sequence { my $tmp = $self->buildlink ($_); return bless \ "$tmp", 'Pod::Man::String'; } - + # Whitespace protection replaces whitespace with "\ ". if ($command eq 'S') { s/\s+/\\ /g; @@ -618,7 +634,12 @@ sub cmd_head1 { local $_ = $self->parse (@_); s/\s+$//; s/\\s-?\d//g; - $self->output (switchquotes ('.SH', $self->mapfonts ($_))); + s/\s*\n\s*/ /g; + if ($$self{ITEMS} > 1) { + $$self{ITEMS} = 0; + $self->output (".PD\n"); + } + $self->output ($self->switchquotes ('.SH', $self->mapfonts ($_))); $self->outindex (($_ eq 'NAME') ? () : ('Header', $_)); $$self{NEEDSPACE} = 0; } @@ -628,11 +649,48 @@ sub cmd_head2 { my $self = shift; local $_ = $self->parse (@_); s/\s+$//; - $self->output (switchquotes ('.Sh', $self->mapfonts ($_))); + s/\s*\n\s*/ /g; + if ($$self{ITEMS} > 1) { + $$self{ITEMS} = 0; + $self->output (".PD\n"); + } + $self->output ($self->switchquotes ('.Sh', $self->mapfonts ($_))); $self->outindex ('Subsection', $_); $$self{NEEDSPACE} = 0; } +# Third level heading. +sub cmd_head3 { + my $self = shift; + local $_ = $self->parse (@_); + s/\s+$//; + s/\s*\n\s*/ /g; + if ($$self{ITEMS} > 1) { + $$self{ITEMS} = 0; + $self->output (".PD\n"); + } + $self->makespace; + $self->output ($self->switchquotes ('.I', $self->mapfonts ($_))); + $self->outindex ('Subsection', $_); + $$self{NEEDSPACE} = 1; +} + +# Fourth level heading. +sub cmd_head4 { + my $self = shift; + local $_ = $self->parse (@_); + s/\s+$//; + s/\s*\n\s*/ /g; + if ($$self{ITEMS} > 1) { + $$self{ITEMS} = 0; + $self->output (".PD\n"); + } + $self->makespace; + $self->output ($self->textmapfonts ($_) . "\n"); + $self->outindex ('Subsection', $_); + $$self{NEEDSPACE} = 1; +} + # Start a list. For indents after the first, wrap the outside indent in .RS # so that hanging paragraph tags will be correct. sub cmd_over { @@ -682,17 +740,19 @@ sub cmd_item { my $index; if (/\w/ && !/^\w[.\)]\s*$/) { $index = $_; - $index =~ s/^\s*[-*+o.]?\s*//; + $index =~ s/^\s*[-*+o.]?(?:\s+|\Z)//; } s/^\*(\s|\Z)/\\\(bu$1/; if ($$self{WEIRDINDENT}) { $self->output (".RE\n"); $$self{WEIRDINDENT} = 0; } - $_ = $self->mapfonts ($_); - $self->output (switchquotes ('.Ip', $_, $$self{INDENT})); + $_ = $self->textmapfonts ($_); + $self->output (".PD 0\n") if ($$self{ITEMS} == 1); + $self->output ($self->switchquotes ('.Ip', $_, $$self{INDENT})); $self->outindex ($index ? ('Item', $index) : ()); $$self{NEEDSPACE} = 0; + $$self{ITEMS}++; } # Begin a block for a particular translator. Setting VERBATIM triggers @@ -746,6 +806,10 @@ sub buildlink { s/^\s+//; s/\s+$//; + # If the argument looks like a URL, return it verbatim. This only + # handles URLs that use the server syntax. + if (m%^[a-z]+://\S+$%) { return $_ } + # Default to using the whole content of the link entry as a section # name. Note that L forces a manpage interpretation, as does # something looking like L. Do the same thing to @@ -795,16 +859,50 @@ sub buildlink { # At this point, we'll have embedded font codes of the form \f([SE] # where is one of B, I, or F. Turn those into the right font start -# or end codes. B else> should map to \fBsome\f(BIthing\fB -# else\fR. The old pod2man didn't get this right; the second \fB was \fR, -# so nested sequences didn't work right. We take care of this by using -# variables as a combined pointer to our current font sequence, and set each -# to the number of current nestings of start tags for that font. Use them -# as a vector to look up what font sequence to use. +# or end codes. The old pod2man didn't get B else> right; +# after I<> it switched back to normal text rather than bold. We take care +# of this by using variables as a combined pointer to our current font +# sequence, and set each to the number of current nestings of start tags for +# that font. Use them as a vector to look up what font sequence to use. +# +# \fP changes to the previous font, but only one previous font is kept. We +# don't know what the outside level font is; normally it's R, but if we're +# inside a heading it could be something else. So arrange things so that +# the outside font is always the "previous" font and end with \fP instead of +# \fR. Idea from Zack Weinberg. sub mapfonts { my $self = shift; local $_ = shift; + my ($fixed, $bold, $italic) = (0, 0, 0); + my %magic = (F => \$fixed, B => \$bold, I => \$italic); + my $last = '\fR'; + s { \\f\((.)(.) } { + my $sequence = ''; + my $f; + if ($last ne '\fR') { $sequence = '\fP' } + ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1; + $f = $$self{FONTS}{($fixed && 1) . ($bold && 1) . ($italic && 1)}; + if ($f eq $last) { + ''; + } else { + if ($f ne '\fR') { $sequence .= $f } + $last = $f; + $sequence; + } + }gxe; + $_; +} + +# Unfortunately, there is a bug in Solaris 2.6 nroff (not present in GNU +# groff) where the sequence \fB\fP\f(CW\fP leaves the font set to B rather +# than R, presumably because \f(CW doesn't actually do a font change. To +# work around this, use a separate textmapfonts for text blocks where the +# default font is always R and only use the smart mapfonts for headings. +sub textmapfonts { + my $self = shift; + local $_ = shift; + my ($fixed, $bold, $italic) = (0, 0, 0); my %magic = (F => \$fixed, B => \$bold, I => \$italic); s { \\f\((.)(.) } { @@ -825,13 +923,15 @@ sub parse { $self->parse_text ({ -expand_seq => 'sequence', -expand_ptree => 'collapse' }, @_); } - + # Takes a parse tree and a flag saying whether or not to treat it as literal # text (not call guesswork on it), and returns the concatenation of all of # the text strings in that parse tree. If the literal flag isn't true, # guesswork() will be called on all plain scalars in the parse tree. -# Assumes that everything in the parse tree is either a scalar or a -# reference to a scalar. +# Otherwise, just escape backslashes in the normal case. If collapse is +# being called on a C<> sequence, literal is set to 2, and we do some +# additional cleanup. Assumes that everything in the parse tree is either a +# scalar or a reference to a scalar. sub collapse { my ($self, $ptree, $literal) = @_; if ($literal) { @@ -840,6 +940,8 @@ sub collapse { $$_; } else { s/\\/\\e/g; + s/-/\\-/g if $literal > 1; + s/__/_\\|_/g if $literal > 1; $_; } } $ptree->children); @@ -935,7 +1037,10 @@ sub guesswork { # Make vertical whitespace. sub makespace { my $self = shift; - $self->output ($$self{INDENT} > 0 ? ".Sp\n" : ".PP\n"); + $self->output (".PD\n") if ($$self{ITEMS} > 1); + $$self{ITEMS} = 0; + $self->output ($$self{INDENT} > 0 ? ".Sp\n" : ".PP\n") + if $$self{NEEDSPACE}; } # Output any pending index entries, and optionally an index entry given as @@ -964,6 +1069,44 @@ sub outindex { # Output text to the output device. sub output { print { $_[0]->output_handle } $_[1] } +# Given a command and a single argument that may or may not contain double +# quotes, handle double-quote formatting for it. If there are no double +# quotes, just return the command followed by the argument in double quotes. +# If there are double quotes, use an if statement to test for nroff, and for +# nroff output the command followed by the argument in double quotes with +# embedded double quotes doubled. For other formatters, remap paired double +# quotes to LQUOTE and RQUOTE. +sub switchquotes { + my $self = shift; + my $command = shift; + local $_ = shift; + my $extra = shift; + s/\\\*\([LR]\"/\"/g; + + # We also have to deal with \*C` and \*C', which are used to add the + # quotes around C<> text, since they may expand to " and if they do this + # confuses the .SH macros and the like no end. Expand them ourselves. + # If $extra is set, we're dealing with =item, which in most nroff macro + # sets requires an extra level of quoting of double quotes. + my $c_is_quote = ($$self{LQUOTE} =~ /\"/) || ($$self{RQUOTE} =~ /\"/); + if (/\"/ || ($c_is_quote && /\\\*\(C[\'\`]/)) { + s/\"/\"\"/g; + my $troff = $_; + $troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g; + s/\\\*\(C\`/$$self{LQUOTE}/g; + s/\\\*\(C\'/$$self{RQUOTE}/g; + $troff =~ s/\\\*\(C[\'\`]//g; + s/\"/\"\"/g if $extra; + $troff =~ s/\"/\"\"/g if $extra; + $_ = qq("$_") . ($extra ? " $extra" : ''); + $troff = qq("$troff") . ($extra ? " $extra" : ''); + return ".if n $command $_\n.el $command $troff\n"; + } else { + $_ = qq("$_") . ($extra ? " $extra" : ''); + return "$command $_\n"; + } +} + __END__ .\" These are some extra bits of roff that I don't want to lose track of @@ -1096,6 +1239,18 @@ Pod::Man doesn't assume you have this, and defaults to CB. Some systems (such as Solaris) have this font available as CX. Only matters for troff(1) output. +=item quotes + +Sets the quote marks used to surround CE> text. If the value is a +single character, it is used as both the left and right quote; if it is two +characters, the first character is used as the left quote and the second as +the right quoted; and if it is four characters, the first two are used as +the left quote and the second two as the right quote. + +This may also be set to the special value C, in which case no quote +marks are added around CE> text (but the font is still changed for troff +output). + =item release Set the centered footer. By default, this is the version of Perl you run @@ -1132,7 +1287,7 @@ details. =over 4 -=item roff font should be 1 or 2 chars, not `%s' +=item roff font should be 1 or 2 chars, not "%s" (F) You specified a *roff font (using C, C, etc.) that wasn't either one or two characters. Pod::Man doesn't support *roff fonts @@ -1145,6 +1300,16 @@ versions of nroff(1) and troff(1) don't either). unable to parse. You should never see this error message; it probably indicates a bug in Pod::Man. +=item Invalid quote specification "%s" + +(F) The quote specification given (the quotes option to the constructor) was +invalid. A quote specification must be one, two, or four characters long. + +=item %s:%d: Unknown command paragraph "%s". + +(W) The POD source contained a non-standard command paragraph (something of +the form C<=command args>) that Pod::Man didn't know about. It was ignored. + =item Unknown escape EE%sE (W) The POD source contained an CE> escape that Pod::Man didn't @@ -1155,6 +1320,11 @@ know about. C%sE> was printed verbatim in the output. (W) The POD source contained a non-standard interior sequence (something of the form CE>) that Pod::Man didn't know about. It was ignored. +=item %s: Unknown command paragraph "%s" on line %d. + +(W) The POD source contained a non-standard command paragraph (something of +the form C<=command args>) that Pod::Man didn't know about. It was ignored. + =item Unmatched =back (W) Pod::Man encountered a C<=back> command that didn't correspond to an diff --git a/contrib/perl5/lib/Pod/ParseUtils.pm b/contrib/perl5/lib/Pod/ParseUtils.pm index 2cb8cdcd3bcd..7d994c750bdc 100644 --- a/contrib/perl5/lib/Pod/ParseUtils.pm +++ b/contrib/perl5/lib/Pod/ParseUtils.pm @@ -10,7 +10,7 @@ package Pod::ParseUtils; use vars qw($VERSION); -$VERSION = 0.2; ## Current version of this package +$VERSION = 0.22; ## Current version of this package require 5.005; ## requires this Perl version or later =head1 NAME @@ -49,7 +49,7 @@ The following methods are available: =over 4 -=item new() +=item Pod::List-Enew() Create a new list object. Properties may be specified through a hash reference like this: @@ -79,7 +79,7 @@ sub initialize { $self->{-type} ||= ''; } -=item file() +=item $list-Efile() Without argument, retrieves the file name the list is in. This must have been set before by either specifying B<-file> in the B @@ -92,7 +92,7 @@ sub file { return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file}; } -=item start() +=item $list-Estart() Without argument, retrieves the line number where the list started. This must have been set before by either specifying B<-start> in the @@ -106,7 +106,7 @@ sub start { return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start}; } -=item indent() +=item $list-Eindent() Without argument, retrieves the indent level of the list as specified in C<=over n>. This must have been set before by either specifying @@ -120,7 +120,7 @@ sub indent { return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent}; } -=item type() +=item $list-Etype() Without argument, retrieves the list type, which can be an arbitrary value, e.g. C
    , C